Håndtering af CSV filer efter sortering

Jeg kan ikke helt overskue hvad problemet er, men hear goes.

Di kan jo importere en ; separeret fil ind i excel. Herinde, vil den fordele de enkelte linier som koloner og stille dataen pænt op i et excel regneark. Hvis du har brug for 4 tomme kolonner, kan disse jo bare laves i excel (de er der allerede), hvis du midlertidigt har brug for at fylde noget i de 4 sidste kolonner, gøres det meget hurtigt ved at skrive et 0 i den øverste celle i de fire sidste kolonner, og så kopiere med musen. Efterfølgende kan du jo eksportere det behandlede regneark til en ny csv fil, med de fire sidste ; med indhold, eller slettet alt efter hvad det er du vil.

Løsningen som jeg forstår den er altså at gå over et mellemstadie som excelregneark

Det er netop det jeg har gjort - men jeg savnede en løsning der IKKE fjernede de tomme felter i linien - det gør Excel'en. når man har lavet lidt i den, bl.a. med Autofilter - gør det pga at felterne er tomme OG står sidst. Jeg har tomme felter midt i recorden som bibeholdes. Korrekt det er som sådan let nok at fylde de fire felter med "0"'er og gemme - men da det er en procedure der kommer til at ske oftere i nærmere fremtid og indtil jeg har et bedre ERP program til eksport - ledte jeg jo efter den hurtigste og letteste løsning. ja det er et mellemstadig at jeg bruger Excel - filen skal sidenhen uploades til diverse Portaler.

Du kan jo prøve denne makro til at gemme med.
Filen skal gemmes i et andet navn og der må ikke være helt tomme linier i dine data.
Data er sat til at starte ved A1

Sub ExportAsCSV()
Const Delim        As String = ";"  'afgrænser (delimiter)
Dim y              As Long          'tæller
Dim x              As Long          'tæller
Dim strTemp        As String        'streng til de enkelte rækker
Dim lRows          As Long          'antal rækker
Dim lCols          As Long          'antal kolonner
Dim lFno            As Long          'fil nummer
Dim RangeToExport  As Range
Dim CVSfilename    As String
Dim ExtraCols      As Long

ExtraCols = 4
csvfilename = Application.GetSaveAsFilename(fileFilter:="CSV Files (*.csv), *.csv")

Set RangeToExport = ActiveSheet.Range("A1").CurrentRegion
Set RangeToExport = RangeToExport.Resize(, RangeToExport.Columns.Count + ExtraCols)
If RangeToExport Is Nothing Then
        MsgBox "ExportRange ikke defineret"
        Exit Sub
End If
lFno = FreeFile
lRows = RangeToExport.Rows.Count
lCols = RangeToExport.Columns.Count
Open csvfilename For Output As #lFno

For x = 1 To lRows
    strTemp = ""
    For y = 1 To lCols
        strTemp = strTemp & RangeToExport(x, y).Text
        If y < lCols Then
            strTemp = strTemp & Delim
        Else
            Print #lFno, strTemp
        End If
    Next
   
Next
Close #lFno
End Sub

>BAK

Det er jo genialt - har dog lidt kvaler med at få den til at tage alle kolonner og alle linier - hvordan retter jeg dette ?

Den tager udgangspunkt i A1 og går til højre til første tomme kolonne og nedad til første tomme række. Resten kommer ikke med.
Dette kan dog nemt fikses enten ved lave makroen således at du skal markere området eller at den chekker på sidste celle.
Hvad ønsker du ?

>BAK

Ok - det er så fordi jeg har tomme felter(kolonner) indimellem. Undrer mig også over den starter filen med at skrive selve macroen - hvad har jeg gjort galt ?

Må så nok ha den til at anvende udskriftsområdet ! Hvad mener du med sidste celle ? Ku man forestille sig man ku taste det antal felter man ved recorden skal være ?

Takker

ng_tnt

Sådan, test så igen denne makro

Sub ExportAsCSV()
Const Delim        As String = ";"  'afgrænser (delimiter)
Dim y              As Long          'tæller
Dim x              As Long          'tæller
Dim strTemp        As String        'streng til de enkelte rækker
Dim lRows          As Long          'antal rækker
Dim lCols          As Long          'antal kolonner
Dim lFno            As Long          'fil nummer
Dim RangeToExport  As Range
Dim CSVfilename    As String
Dim ExtraCols      As Long

ExtraCols = 4
CSVfilename = Application.GetSaveAsFilename(fileFilter:="CSV Files (*.csv), *.csv")
Set RangeToExport = Range("A1", LastCell(ActiveSheet).Address)
Set RangeToExport = RangeToExport.Resize(, RangeToExport.Columns.Count + ExtraCols)
If RangeToExport Is Nothing Then
        MsgBox "ExportRange ikke defineret"
        Exit Sub
End If
lFno = FreeFile
lRows = RangeToExport.Rows.Count
lCols = RangeToExport.Columns.Count
Open CSVfilename For Output As #lFno

For x = 1 To lRows
    strTemp = ""
    For y = 1 To lCols
        strTemp = strTemp & RangeToExport(x, y).Text
        If y < lCols Then
            strTemp = strTemp & Delim
        Else
            Print #lFno, strTemp
        End If
    Next
   
Next
Close #lFno
End Sub

Function LastCell(ws As Worksheet) As Range
  Dim LastRow&, LastCol%
  On Error Resume Next
  With ws
    LastRow& = .Cells.Find(What:="*", _
      SearchDirection:=xlPrevious, _
      SearchOrder:=xlByRows).Row
    LastCol% = .Cells.Find(What:="*", _
      SearchDirection:=xlPrevious, _
      SearchOrder:=xlByColumns).Column

  End With
  Set LastCell = ws.Cells(LastRow&, LastCol%)
End Function

>BAK

Simpelthen GENIALT....

Mange tak for hjælpen !

UPS - smid lige et svar BAK

ok, glad for, at du kan bruge det

en lille sidste ting - hvordan fan gemmer jeg macroen så den gælder fremtidige filer - skal oprette den for hver gang jeg åbner Excel (Office XP)

;-)

Du skal gemme den i person.xls
hvis du ikke kan finde den i VBA editoren er det måske fordi den ikke er der.
Så opretter du den ved at indspille en ny makro og der hvor der Gem makroen i vælger du Personligt makroark.
Afslut indspilning og du har så person.xls til rådighed. Den er skjult og vil altid åbnes sammen med excel for eftertiden.