Spalten AA und größer befüllen lassen
09.02.2022 11:30:28
Mitsakos
ich habe folgendes Problem. Über eine Schleife vergleiche ich Daten und möchte dann bei einem Treffer in Tabelle2 einige Spalten befüllen. Diese gehen jedoch über die Spalte Z hinaus sprich, es müssen auch die Spalten AA fortaufend befüllt werden. Ihr findet anbei die Beispielmappe : https://www.herber.de/bbs/user/151012.xlsm
Ich habe folgenden Code im Netz gefunden und etwas an meine Bedürfnisse angepasst. Leider endet die Schleife an Spalte Z, dann wird mit einer Fehlermeldung abgebrochen "Laufzeifehler 1004 Anwendungs oder Objektdefinierter Fehler". Ich vermute, dass die chr Funktion keinen größeren Wert als Z kennt?
Sub SucheNachInhalten()
Dim lngZeile As Long
Dim lngSpalteMax As Long
Dim lngZeileMax As Long
Dim lngSpalte As Long
Dim lngZeileMax2 As Long
Dim VarDat As Variant
Dim i As Integer
Dim sQuellSpalte As String
Dim sZielSpalte As String
Dim lngQuellZeile As Long
Dim lngQuellSpalte As Long
Dim lngZielZeile As Long
Dim lngZielSpalte As Long
With Sheets("Tabelle1")
'Ermittel die letzte beschriebene Zeile in Spalte A "Tabelle1" und speichere den Wert in Variable lngZeileMax
lngZeileMax = .Range("A" & .Rows.Count).End(xlUp).Row
'Ermittel die Anzahl der beschriebenen Spalten in "Tabelle1" und speichere den Wert in Variable lngSpalteMax
lngSpalteMax = .UsedRange.SpecialCells(xlCellTypeLastCell).Column
'Ermittel die letzte beschriebene Zelle in Spalte A "Tabelle2" und speichere den Wert in Variable lngZeileMax2
lngZeileMax2 = Sheets("Tabelle2").Range("A" & .Rows.Count).End(xlUp).Row
'Schleife zum durchsuchen der Zeilen von Zeile 2 beginnend bis zur letzten beschriebenen Zeile in Spalte A
For lngZeile = 2 To lngZeileMax
'Definiere Suchbereich der Schleife
VarDat = Sheets("Tabelle2").Range("A2:A" & lngZeileMax2)
'Pruefe nun Zeile fuer Zeile im definierten Suchbereich VarDat
For i = 1 To UBound(VarDat)
'Wenn der Wert in der Zeile "Tabelle1" = Wert in der Zeile "Tabelle2"
If .Range("A" & lngZeile).Value = VarDat(i, 1) Then
'dann starte neue Schleife und beginne mit Uebertrag der Daten in die Zielzeile und Zielspalte
For lngSpalte = 3 To (lngSpalteMax - 1)
lngQuellZeile = lngZeile
lngQuellSpalte = lngSpalte
lngZielZeile = i + 1
lngZielSpalte = lngQuellSpalte - 7
'Übertrage Daten in die Spalten
sQuellSpalte = Chr(lngQuellSpalte + 70)
sZielSpalte = Chr(lngZielSpalte + 70)
Sheets("Tabelle2").Range(sZielSpalte & lngZielZeile) = .Range(sQuellSpalte & lngQuellZeile)
Next lngSpalte
End If
Next i
Next lngZeile
End With
End Sub