Kompilerfehler?
RalfTh
Ich bin ratlos
Wenn ich den unten stehenden Code ausführen will kommt eine Kompilermeldung Fehler beim kompilieren: Next ohne For
Das betrifft das Fett markierte/Kursive Next(ziemlich unten). Wenn ich es auskommentiere bringet der Kompiler die Meldung FOR-Steuervariable wird bereits verwendet.
Das betrifft an das Fett markierte/Kursive FOR(noch etwas darunter) im Code:
Sub DatenErgaenzen(wbDest As Workbook)
' Variablendeklaration
Dim StrTitel, SheetPraef, strTest As String ' Titel für Überschrift
Dim Arr() As Variant ' Dynamisches Array
Dim intArr As Integer ' Zähler für Array
Dim lngRow As Long ' Zähler für Schleife Zeilen
Dim lngArr As Long ' Zähler für Schleife Array
Dim wsImp As Worksheet ' Import Tabellenblatt
Dim wsINI As Worksheet ' INI Tabellenblatt
Dim wsLog As Worksheet ' Error_Log Tabellenblatt
Dim wsdest As Worksheet ' Zielblatt für Eintrag
Dim blerror As Boolean ' Fehler in Importzeile
Dim lngCol As Long ' Anzahl benutzte Zellen
Dim lnglogCol As Long ' Offset Spalte für Logeintrag
ThisWorkbook.Activate
G_ProcName = "Daten In Zielzellen eintragen"
' Falls bereits ein Tabellenblatt mit dem Namen "Error_Log"
' besteht, wird es gelöscht
' Referenzierung auf das Import-Tabellenblatt
Set wsImp = Worksheets(Worksheets("INI").Cells(7, 6).Value)
' Referenzierung auf das INI-Tabellenblatt
Set wsINI = Worksheets(Worksheets("INI").Cells(6, 6).Value)
'Referenzierung auf das Tabellenblatt Error_Log
Set wsLog = Worksheets(Worksheets("INI").Cells(9, 6).Value)
' Anhand der ersten Spalte die Anzahl der benutzten
' Zellen ermitteln
lngRow = 2
lngCol = 1
'strTest = arr(1, 1)
G_ErrorRow = 2
SheetPraef = Worksheets("INI").Cells(11, 6).Value
StrTitel = "VerarbeitungsProtokoll"
' Das Array für den ersten Eintrag dimensionieren
G_SubPart = "Das Array für den ersten Eintrag dimensionieren"
ReDim Arr(1 To G_ImpRow, 1 To 7)
With wsImp
' Das Array nach und nach mit Werten aus dem Blatt Importdaten füllen
G_SubPart = "Das Array nach und nach mit Werten aus dem Blatt Importdaten füllen"
For lngRow = 2 To G_ImpRow
For lngCol = 1 To 6
Select Case lngCol
Case 1 To 5
Arr(lngRow, lngCol) = .Cells(lngRow, lngCol)
Case 6
Arr(lngRow, lngCol) = SheetPraef & .Cells(lngRow, lngCol - 1)
End Select
Next lngCol
lngCol = 1
Next lngRow
End With
With wsLog
' Überschriften für das Log ins Tabellenblatt einfügen
G_SubPart = "Überschriften für das Log ins Tabellenblatt einfügen"
If .Range("F1") "" Then
Dim Button, Prio, Text, Titel As Variant
Button = vbYes
Prio = vbInformation
Titel = "Eingangsdaten verarbeiten"
'Text ändern oder leer lassen. Wenn leer Button automatisch vbYes und Programmende
Text = "Die Logeinträge werden zurückgesetzt."
Prio = MsgBox(Text, Button, Titel)
.Columns("F:L").Delete
End If
.Range("F1").Value = "Name"
.Range("G1").Value = "Miles Element"
.Range("H1").Value = "Buchungsmonat"
.Range("I1").Value = "Stunden"
.Range("J1").Value = "alter Stundenwert"
.Range("K1").Value = "Projektblatt"
.Range("L1").Value = "Verarbeitung"
With .Range("F1:L1")
.Interior.ColorIndex = 36
.Font.Bold = True
End With
End With
' Spalte und Zeile initialisiern für Logausgabe
G_SubPart = "Spalte und Zeile initialisiern für Logausgabe"
lngRow = 2
lngCol = 1
lnglogCol = 5 'Damit die Daten ab Spalte 5 eingetragen werden
'Daten zeilenweise aus Array lesen, verarbeiten und protokollieren
G_SubPart = "Daten zeilenweise aus Array lesen, verarbeiten und protokollieren"
Dim destRow, iRow, iCol, oldValue, destCol, ErrorTxt As Variant
Dim LocateError As Boolean
For lngRow = 2 To G_ImpRow
For lngCol = 1 To 7
Select Case lngCol
Case 1
G_ImpName = Split(Arr(lngRow, lngCol), " ") 'Suchen und splitten bis zum _
ersten Leerzeichen
Case 3
G_ImpDate = Arr(lngRow, lngCol)
Case 4
G_Imptime = Arr(lngRow, lngCol)
Case 6
G_DestSheetName = Arr(lngRow, lngCol)
End Select
Next lngCol
With wbDest
With Worksheets(G_DestSheetName).Range("A22:A500")
destRow = Application.Match(CDbl(G_ImpName), .cols(1), 0)
'Set destRow = .Find(G_ImpName, LookIn:=xlValues)
If destRow Is Nothing Then
LocateError = True
Else
iRow = destRow.Row
End If
With Worksheets(G_DestSheetName)
destCol = Application.Match(CDbl(DateSerial(Year(G_ImpDate), Month(G_ImpDate), _
1)), .Rows(1), 0)
If iCol = "" Then
LocateError = True
Else
iCol = destCol.Row
End If
End With
If LocateError = True Then GoTo NextRow
End With
NextRow:
'If LocateError = True Then Arr(lngRow, lngCol + lnglogCol) = "Koordinaten nich gefunden"
Next lngRow
With wsLog
' Das Log mit den Werten aus dem Array füllen
G_SubPart = "Das Log mit den Werten aus dem Array füllen"
For lngRow = 2 To G_ImpRow
For lngCol = 1 To 7
Select Case lngCol
Case 1 To 4
.Cells(lngRow, lngCol + lnglogCol) = Arr(lngRow, lngCol)
Case 5
'.Cells(lngRow, lngCol + lnglogCol) = 0
Case 6
.Cells(lngRow, lngCol + lnglogCol) = Arr(lngRow, lngCol)
Case 7
.Cells(lngRow, lngCol + lnglogCol) = Arr(lngRow, lngCol)
End If
End Select
Next lngCol
lngCol = 1
Next lngRow
End With
' Die Objektverweise freigeben
G_SubPart = "Die Objektverweise freigeben"
Set wsImp = Nothing
Set wsLog = Nothing
Set wsINI = Nothing
Set destRow = Nothing
Exit Sub
End Sub
Gruß Ralf