Bereich in Array einlesen
06.08.2015 09:08:16
Anna
Ich möchte einen Code, der prüft, ob die Werte von Zeile 3:100 in Spalte G der Tabelle 3 und Spalte D der Tabelle 1 übereinstimmen.
Stimmen die Werte überein, so soll der Bereich der übereinstimmenden Zeile (von E bis SF) von Tabelle 1 in Tabelle 3 kopieren.
Ich hab folgenden Code gefunden und abgeändert.
Bisher wird nur der Bereich E:F in die Tabelle 3 kopiert.
Wie kann der Bereich E:SF kopiert werden?
Public Sub machs()
Dim myTarget As Variant
Dim myOrigin As Variant
Dim myDic As Object
Dim L As Long
myTarget = Sheets("Tabelle3").Range("G3:J160") 'Anpassen
myOrigin = Sheets("Tabelle1").Range("D3:G160") 'Anpassen
Set myDic = CreateObject("Scripting.Dictionary")
For L = LBound(myOrigin) To UBound(myOrigin) 'Unikate sammeln
myDic(myOrigin(L, 1)) = Array(myOrigin(L, 2), myOrigin(L, 3)) 'Zu jedem Unikat die _
passenden Werte aus Value_Origin aufnehmen
Next
For L = LBound(myTarget) To UBound(myTarget)
If myDic.exists(myTarget(L, 1)) Then 'Prüfung ob wert aus Offset_Target in _
Ofrfset_Origin vorhanden
myTarget(L, 3) = myDic(myTarget(L, 1))(0) 'Wenn ja Werte übertragen
myTarget(L, 4) = myDic(myTarget(L, 1))(1)
End If
Next
Sheets("Tabelle3").Range("G3:J160") = myTarget 'Alles wieder zurückschreiben
End Sub
Anzeige