Bereich in Array einlesen

Bild

Betrifft: Bereich in Array einlesen
von: Anna
Geschrieben am: 06.08.2015 09:08:16

Hallo zusammen,
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
Liebe Grüße

Bild

Betrifft: AW: Bereich in Array einlesen
von: ransi
Geschrieben am: 06.08.2015 13:09:14
Hallo Anna,
Der Code kommt mir vertraut vor....
Wenn du eine Beispieltabelle hochlädst kann ich den Code anpassen.
ransi

Bild

Betrifft: AW: Bereich in Array einlesen
von: Anna
Geschrieben am: 06.08.2015 14:55:01
Hallo Ransi,
das wäre so was von super :).
Hier die Tabelle.
Die gelben Spalten der Tabelle 3 und 1 sollen verglichen werden.
https://www.herber.de/bbs/user/99365.xlsx
Liebe Grüße

Bild

Betrifft: AW: Bereich in Array einlesen
von: Anna
Geschrieben am: 09.08.2015 07:43:36
Hat jemand eine Idee?
Lg

Bild

Betrifft: AW: Bereich in Array einlesen
von: ransi
Geschrieben am: 09.08.2015 10:31:21
HAllo Anna,
Teste mal an einer Kopie deiner Originaldaten:

Option Explicit

Public Sub machs()
    Dim myTarget As Variant
    Dim myOrigin As Variant
    Dim myDic As Object
    Dim L As Long
    Dim myOut As Variant 'Ausgabearray
    Dim myItem As Variant 'Passende Wertezeile
    Dim lngIndex As Long
    myOrigin = Sheets("Tabelle1").Range("D3:SF160") 'Anpassen
    myTarget = Sheets("Tabelle3").Range("G2:G160") 'Anpassen
    Redim myOut(1 To UBound(myTarget), 1 To UBound(myOrigin, 2) - 1)
    Set myDic = CreateObject("Scripting.Dictionary")
    For L = LBound(myOrigin) To UBound(myOrigin) 'Unikate sammeln
        myDic(myOrigin(L, 1)) = WorksheetFunction.Index(myOrigin, L) '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 vorhanden
            myItem = myDic(myTarget(L, 1))
            For lngIndex = 2 To UBound(myItem)
                myOut(L, lngIndex - 1) = myItem(lngIndex)
            Next
        End If
    Next
    Sheets("Tabelle3").Range("H2").Resize(UBound(myOut), UBound(myOut, 2)) = myOut 'Alles wieder zurückschreiben
End Sub


ransi

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Bereich in Array einlesen"