Registriert seit: 07.03.2016
Version(en): 2013
Hallo,
ich möchte gerne mit dem unten angegebenen Code Tabelle 2 auf Übereinstimmung mit der Zahl im angegebenen Feld in Tabelle 1 prüfen und bei Übereinstimmung Zahlenwerte aus der jeweiligen Zeile von Tabelle 1 in Tabelle 2 kopieren. Es sind jedoch gewisse Werte von Tabelle 2 in mehreren Zeilen von Tabelle 1 vorhanden, welche mit dem unten angegebenen Code jedoch leider nicht kopiert werden (es wird nur immer jeweils ein übereinstimmender Eintrag kopiert). Was müsste in dem Code ergänzt werden, dass alle übereinstimmenden Werte in Tabelle 1 sowie dazugehörig die unten angegebenen Werte untereinander in Tabelle 2 kopiert werden?
Sub EleFolge_A1()
Dim LoL_1 As Long
Dim LoL_2 As Long
Dim r1 As Long
Dim r2 As Long
Dim erg
Dim ws2 As Worksheet
Set ws2 = Worksheets("Tabelle1")
With Worksheets("Tabelle 2")
LoL_1 = .Cells(Rows.Count, "K").End(xlUp).Row
LoL_2 = ws2.Cells(Rows.Count, "A").End(xlUp).Row
For r1 = 2 To LoL_1
If .Range("K" & r1) <> "" Then
erg = Application.Match(.Range("K" & r1), ws2.Range("A2:A" & LoL_2), 0)
If IsNumeric(erg) Then
r2 = erg + 1
.Range("O" & r1) = ws2.Range("C" & r2)
.Range("M" & r1) = ws2.Range("A" & r2)
End If
End If
Next r1
End With
End Sub
Registriert seit: 12.03.2016
Version(en): Excel 2003/ 2016
Hallo,
es Weihnachtet sehr, frohes Fest. Es ist mir zuvie Arbeit meinen Vorschlag zu testen, gib dir aber einen guten Tipp.
Baue in die For Next Schleife eine Wiederholung ein, solange r2 < LoL_2 ist. Füge r2 in die Match Zeile für die Bereichsadresse bei "A2" ein. Dadurch veraendert sich der Bezugs Bereich für Match. Es kann sein das du noch eine Zeile zum Fehlerabfangen einbauen musst, wenn Match nichts mehr findet!
Probiere zuerst mal die Version ohne Error, die mit Err > 0 Zeile wurde dıurch ' Zeichen deaktiviert. Wenn eine Laufzeitfehler kommt probier die Variante mit Err > 0. Ich hoffe es klappt.
mfg Gast 123 Frohes Fest ....
Code:
r2 = 2 '1. Zeile
On Error Resume Next
For r1 = 2 To LoL_1
If .Range("K" & r1) <> "" Then
wdh: erg = Application.Match(.Range("K" & r1), ws2.Range("A" & r2 & ":A" & LoL_2), 0)
If IsNumeric(erg) Then
r2 = erg + 1
.Range("O" & r1) = ws2.Range("C" & r2)
.Range("M" & r1) = ws2.Range("A" & r2)
'Match mit r2 Zelle wiederholen (mit Err ??)
'if Err = 0 And r2 < LoL_2 Then GoTo Wdh
'if Err > 0 Then Err = 0
if r2 < LoL_2 Then GoTo Wdh
End If
End If
Next r1
End With
Registriert seit: 13.04.2014
Version(en): 365
Hallo,
abgesehen davon, dass man das auch mit Formeln bewerkstelligen könnte, braucht man hier keinen Vergleich:
Code:
Sub EleFolge_A1()
Dim LoL_1 As Long
Dim LoL_2 As Long
Dim r1 As Long
Dim r2 As Long
Dim z1 As Long
Dim x1 As Long
Dim erg
Dim ws2 As Worksheet
Set ws2 = Worksheets("Tabelle1")
With Worksheets("Tabelle2")
LoL_1 = .Cells(Rows.Count, "K").End(xlUp).Row
LoL_2 = ws2.Cells(Rows.Count, "A").End(xlUp).Row
z1 = 2
For r1 = 2 To LoL_1
For x1 = 1 To LoL_2
If ws2.Range("A" & x1) = .Range("K" & r1) Then
.Range("O" & z1) = ws2.Range("C" & x1)
.Range("M" & z1) = ws2.Range("A" & x1)
z1 = z1 + 1
End If
Next
Next
Gruß
Edgar
Meine Antworten sind freiwillig und ohne Gewähr!
Über Rückmeldungen würde ich mich freuen.
Registriert seit: 07.03.2016
Version(en): 2013
Hallo,
vielen Dank für die Antworten, nun habe ich noch ein Problem. Wenn ich mit dem unten angeführten Code einige Zellen aus Tabelle 1 in die Spalten O und M auslese und anschließend mit diesem Code in einem neuen Makro Zellen aus Tabelle 3 in die Spalten P und Q auslese, werden die Werte beider Abfragen nebeneinander in dieselben Zeilen eingetragen. Ich möchte die Werte der zweiten Abfrage (aus Tabelle 3) jedoch gerne in den nachfolgenden Zeilen nach den Werten von Tabelle 1 haben. Was müsste ich da im Code ergänzen?
Registriert seit: 13.04.2014
Version(en): 365
Hallo,
und wie sieht Dein jetziger Code aus?
Gruß
Edgar
Meine Antworten sind freiwillig und ohne Gewähr!
Über Rückmeldungen würde ich mich freuen.
Registriert seit: 07.03.2016
Version(en): 2013
Hallo,
momentan habe ich zwei Makros, welche mir aufeinanderfolgend die Werte aus den Tabellen auslesen (siehe unten). Die Werte der zweiten Abfrage sollten jedoch erst in der nächsten leeren Zeile nach den Werten der ersten Abfrage aufgelistet werden.
Sub EleFolge_A1()
Dim LoL_1 As Long
Dim LoL_2 As Long
Dim r1 As Long
Dim r2 As Long
Dim erg
Dim ws2 As Worksheet
Set ws2 = Worksheets("Tabelle1")
With Worksheets("Tabelle 2")
LoL_1 = .Cells(Rows.Count, "K").End(xlUp).Row
LoL_2 = ws2.Cells(Rows.Count, "A").End(xlUp).Row
For r1 = 2 To LoL_1
If .Range("K" & r1) <> "" Then
erg = Application.Match(.Range("K" & r1), ws2.Range("A2:A" & LoL_2), 0)
If IsNumeric(erg) Then
r2 = erg + 1
.Range("O" & r1) = ws2.Range("C" & r2)
.Range("M" & r1) = ws2.Range("A" & r2)
End If
End If
Next r1
End With
End Sub
Sub EleFolge_A2()
Dim LoL_1 As Long
Dim LoL_2 As Long
Dim r1 As Long
Dim r2 As Long
Dim erg
Dim ws2 As Worksheet
Set ws2 = Worksheets("Tabelle3")
With Worksheets("Tabelle 2")
LoL_1 = .Cells(Rows.Count, "K").End(xlUp).Row
LoL_2 = ws2.Cells(Rows.Count, "A").End(xlUp).Row
For r1 = 2 To LoL_1
If .Range("K" & r1) <> "" Then
erg = Application.Match(.Range("K" & r1), ws2.Range("A2:A" & LoL_2), 0)
If IsNumeric(erg) Then
r2 = erg + 1
.Range("P" & r1) = ws2.Range("C" & r2)
.Range("Q" & r1) = ws2.Range("A" & r2)
End If
End If
Next r1
End With
End Sub
Registriert seit: 07.03.2016
Version(en): 2013
Registriert seit: 07.03.2016
Version(en): 2013
Hallo,
wer kennt eine Möglichkeit, mittels Makro die erste leere Zeile in einem Tabellenblatt zu ermitteln, nachdem bereits Werte über das Makro EleFolge_A1 (siehe oben) in die Tabelle eingetragen wurden. Nachfolgend sollten mittels dem Makro EleFolge_A2 (siehe oben) die zusätzlich ermittelten Werte ab der ersten ermittelten Leerzeile eingetragen werden.
Registriert seit: 13.04.2014
Version(en): 365
Hallo,
zum Einen halte ich nichts von der Lösung mit Match, zum Anderen würde ich mal gerne eine Mustertabelle sehen, mit Wunschergebnis.
Gruß
Edgar
Meine Antworten sind freiwillig und ohne Gewähr!
Über Rückmeldungen würde ich mich freuen.
Registriert seit: 07.03.2016
Version(en): 2013
Hallo,
was wäre die Alternative zum Code oben? Ich würde nämlich gerne Einträge aus verschiedenen Tabellen nacheinander suchen (Abstimmung über gemeinsame ID wie bei einer Datenbank) und in eine neutrale Tabelle eintragen. Die Codes oben erledigen das schon sehr zuverlässig. Das Problem ist nur, dass die von den Makros gelieferten Einträge in dieselben Zeilen geschrieben werden und somit nicht getrennt betrachtet werden können.
