AW: csv - DS eine ID zufügen
12.11.2022 14:07:05
Nepumuk
Hallo Fred,
teste mal:
Option Explicit
Public Sub Fred()
Const FOLDER_PATH As String = "C:\Users\Fred Neumann\Desktop\scalping\"
Dim strFilename As String
Dim lngLastRow As Long
Dim objWorkbook As Workbook
Application.ScreenUpdating = False
strFilename = Dir$(FOLDER_PATH & "*.csv")
Do Until strFilename = vbNullString
Set objWorkbook = Workbooks.Open(Filename:=FOLDER_PATH & strFilename, Local:=True)
With objWorkbook.Worksheets(1)
If GetLastCell(Cells, lngLastRow, 0, True, False) Then
Call .Columns(1).Insert
.Cells(1, 1).Value = "ID"
.Cells(2, 1).Value = 1
Call .Range(.Cells(2, 1), .Cells(lngLastRow, 1)).DataSeries
End If
End With
Application.DisplayAlerts = False
Call objWorkbook.SaveAs(Filename:=FOLDER_PATH & strFilename, FileFormat:=xlCSV, Local:=True)
Application.DisplayAlerts = True
Call objWorkbook.Close(SaveChanges:=False)
Set objWorkbook = Nothing
strFilename = Dir$
Loop
Application.ScreenUpdating = True
End Sub
Private Function GetLastCell( _
ByRef probjRange As Range, _
ByRef prlngLastRow As Long, _
ByRef prlngLastColumn As Long, _
Optional ByVal povblnReturnLastRow As Boolean = True, _
Optional ByVal povblnReturnLastColumn As Boolean = True) As Boolean
Dim objCell As Range
If Application.CountBlank(probjRange) probjRange.Cells.CountLarge Then
With probjRange
If povblnReturnLastRow Then
Set objCell = .Find(What:="*", LookIn:=xlValues, Lookat:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
prlngLastRow = objCell.Row
GetLastCell = True
End If
If povblnReturnLastColumn Then
Set objCell = .Find(What:="*", LookIn:=xlValues, Lookat:=xlWhole, _
SearchOrder:=xlByColumns, SearchDirection:=xlPrevious)
prlngLastColumn = objCell.Column
GetLastCell = True
End If
End With
Set objCell = Nothing
End If
End Function
Gruß
Nepumuk