CSV fil med ekstra ,'er

lad os se koden

Sub CreatAndExportCSVFILE()

Dim FName As String
Dim fs
Dim WholeLine As String
Dim FNum As Integer
Dim RowNdx As Long
Dim ColNdx As Integer
Dim StartRow As Long
Dim EndRow As Long
Dim StartCol As Integer
Dim EndCol As Integer
Dim CellValue As String
Dim Sep As String

Application.ScreenUpdating = False

On Error GoTo EndMacro:

FNum = FreeFile

Sep = ","

FName = ThisWorkbook.Path & "MACRO.csv"


Set fs = CreateObject("Scripting.FileSystemObject")
If fs.FileExists(FName) Then
Kill FName
End If

Range("A1:AG142").Select

With Selection
StartRow = .Cells(1).Row
StartCol = .Cells(1).Column
EndRow = .Cells(.Cells.Count).Row
EndCol = .Cells(.Cells.Count).Column
End With

Open FName For Output Access Write As #FNum

For RowNdx = StartRow To EndRow
WholeLine = ""
For ColNdx = StartCol To EndCol
If Cells(RowNdx, ColNdx).Value = "" Then
CellValue = ""
Else
CellValue = _
Application.WorksheetFunction.Text _
(Cells(RowNdx, ColNdx).Value, _
Cells(RowNdx, ColNdx).NumberFormat)
End If
WholeLine = WholeLine & CellValue & Sep
Next ColNdx
WholeLine = Left(WholeLine, Len(WholeLine) - Len(Sep))
Print #FNum, WholeLine
Next RowNdx

EndMacro:
On Error GoTo 0

Application.ScreenUpdating = True

Close #FNum

Range("A1").Select

End Sub

prøv at ændre denne For RowNdx = StartRow To EndRow
til For RowNdx = StartRow To EndRow-1

Stadig en masse "," til sidst... det ser nogenlunde sådan ud:
1,2,3,slut,,,,,,,,,,,,,,,,,,,,
4,5,6,slut,,,,,,,,,,,,,,,,,,,,
nogle ideer?

nu vælger du jo området, med "Range("A1:AG142").Select"

hvis du ikke har data i de sidste 20 kolonner, vil du jo få "," for hver en af cellerne, der er tom.

Pisselækkert :-) svar og du skal modtage dine points jeg anede ikke den var så følsom hehe... min fejl

et svar ;-))

super tak. Har du evt en løsnign til at excel beder mig om et område hvor jeg kan tage det fra via noget ala msgbox? jeg forestiller mig at den skriver:
"start" så skriver jeg eks A1:A9. og så skal jeg vælge et område igen (det er to forskellige størrelser af felter jeg arbejder med i samme fil) så eksempelvis A2:AW310).... og vupti det er kommet ned i en csv fil....
mvh Lars

Her er et eksempel på at den spørger, du kan sætte ind i din eksisterende kode.

Jeg har kun tjekket på et område, men du kan jo prøve at teste på flere, det skrives sådan: A1:C3;G1:G3

Dim Sep As String
Dim Område As String
Application.ScreenUpdating = False

On Error GoTo EndMacro:

FNum = FreeFile

Sep = ","

FName = ThisWorkbook.Path & "MACRO.csv"


Set fs = CreateObject("Scripting.FileSystemObject")
If fs.FileExists(FName) Then
Kill FName
End If
Område = InputBox("Indtast området således ( A1:C3 )", "Område")
If Område = "" Then Exit Sub
Range(Område).Select

With Selection

jeg kan ikke få den til at vælge mere end et område... hvis jeg skriver a1:k9; a2:aw310 så vælger den kun første del!
virker det for dig?

her er min kode....


Sub convert()
' By dkbevl
Dim FName As String
Dim fs
Dim WholeLine As String
Dim FNum As Integer
Dim RowNdx As Long
Dim ColNdx As Integer
Dim StartRow As Long
Dim EndRow As Long
Dim StartCol As Integer
Dim EndCol As Integer
Dim CellValue As String
Dim Sep As String
Dim range1 As String
Dim range2 As String
Dim file1 As String
Dim Omraade As String

 
' converting text to numbers
Range("D:D,M:S").Select
Range("M1").Activate
Selection.NumberFormat = "0"

' User selects the correct array to convert
'file1 = InputBox(myPrompt, "FIL NAME")


Application.ScreenUpdating = False

On Error GoTo EndMacro:
FNum = FreeFile
Sep = "|"



' NOTE TO SELF.... insert FILE1 in FNAME

FName = ThisWorkbook.Path & "MACRO MACRO.csv"
Set fs = CreateObject("Scripting.FileSystemObject")
If fs.FileExists(FName) Then
Kill FName
End If

Omraade = InputBox("Indtast området således ( A1:C3 )", "Område")
If Omraade = "" Then Exit Sub
Range(Omraade).Select


'Range(range1).Select

With Selection
StartRow = .Cells(1).Row
StartCol = .Cells(1).Column
EndRow = .Cells(.Cells.Count).Row
EndCol = .Cells(.Cells.Count).Column
End With

Open FName For Output Access Write As #FNum

For RowNdx = StartRow To EndRow
WholeLine = ""
For ColNdx = StartCol To EndCol
If Cells(RowNdx, ColNdx).Value = "" Then
CellValue = ""
Else
CellValue = _
Application.WorksheetFunction.Text _
(Cells(RowNdx, ColNdx).Value, _
Cells(RowNdx, ColNdx).NumberFormat)

End If
WholeLine = WholeLine & CellValue & Sep
Next ColNdx
WholeLine = Left(WholeLine, Len(WholeLine) - Len(Sep))
Print #FNum, WholeLine
Next RowNdx


EndMacro:
On Error GoTo 0

Application.ScreenUpdating = True

Close #FNum
End Sub

skal områderne under hinanden, eller ved siden af hinanden ??

De ligger under... eksempelvis a1:k9,a2:aw310,a311;k311,a312:aw400
vh Lars