Wert in Zelle per Makro, 2 Suchkriterien

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub VarianteA() Dim Wb As Workbook: Set Wb = ThisWorkbook Dim WsQ As Worksheet: Set WsQ = Wb.Worksheets("Tabelle1") Dim WsZ As Worksheet: Set WsZ = Wb.Worksheets("Tabelle2") Dim Such As Range: Set Such = WsQ.Range("A3") Dim Wert As Range: Set Wert = WsQ.Range("C3") Dim Liste As Range: Set Liste = WsZ.Range(WsZ.Cells(1, 1), WsZ.Cells(WsZ.Rows.Count, 1).End(xlUp)) Dim Wo Wo = Application.Match(Such, Liste, 0) If Not IsError(Wo) Then WsZ.Cells(Wo, 4) = Wert.Value End If Set Wb = Nothing: Set WsQ = Nothing: Set WsZ = Nothing Set Such = Nothing: Set Wert = Nothing: Set Liste = Nothing End Sub Sub VarianteB() Dim Wb As Workbook: Set Wb = ThisWorkbook Dim WsQ As Worksheet: Set WsQ = Wb.Worksheets("Tabelle1") Dim WsZ As Worksheet: Set WsZ = Wb.Worksheets("Tabelle2") Dim SuchA As Range: Set SuchA = WsQ.Range("A7") Dim SuchB As Range: Set SuchB = WsQ.Range("B7") Dim Wert As Range: Set Wert = WsQ.Range("C7") Dim Liste As Range, CheckKrit As Range, Wo Application.ScreenUpdating = False With WsZ Set Liste = .Range(.Cells(2, 1), .Cells(.Rows.Count, 3).End(xlUp)) Set CheckKrit = Liste.Offset(, 4).Resize(Liste.Rows.Count, 1) CheckKrit.FormulaR1C1 = "=RC[-3]&""-""&RC[-2]" Wo = Application.Match(SuchA & "-" & SuchB, CheckKrit, 0) If Not IsError(Wo) Then .Cells(Wo + 1, 4) = Wert.Value End If CheckKrit.ClearContents End With Application.ScreenUpdating = True Set Wb = Nothing: Set WsQ = Nothing: Set WsZ = Nothing Set SuchA = Nothing: Set SuchB = Nothing: Set Wert = Nothing Set List = Nothing: Set CheckKrit = Nothing End Sub

Hallo Michael,
vielen vielen Dank für den Code, genau so habe ich es mir vorgestellt!
Ich habe es gerade in meine Originaltabelle übertragen, wo das Suchkriterium jedoch in Zelle E14 steht und der Wert in N37 steht.
In der Zieltabelle ist das Suchkriterium dann wiederum in Spalte C und die Zielspalte ist AQ. Ich habe den Code daher wie folgt angepasst:
Dim Wb As Workbook: Set Wb = ThisWorkbook
Dim WsQ As Worksheet: Set WsQ = Wb.Worksheets("Tabelle1")
Dim WsZ As Worksheet: Set WsZ = Wb.Worksheets("Tabelle2")
Dim Such As Range: Set Such = WsQ.Range("E14")
Dim Wert As Range: Set Wert = WsQ.Range("N37")
Dim Liste As Range: Set Liste = WsZ.Range(WsZ.Cells(3, 1), WsZ.Cells(WsZ.Rows.Count, 1).End(xlUp))
Dim Wo
Wo = Application.Match(Such, Liste, 0)
If Not IsError(Wo) Then
WsZ.Cells(Wo, 43) = Wert.Value
End If
Leider macht das Makro dann hier nichts - habe ich irgendwo einen Fehler drin und muss noch etwas anpassen?
Liebe Grüße
Xenia

Sub VarianteNeuB() Dim Wb As Workbook: Set Wb = ThisWorkbook Dim WsQ As Worksheet: Set WsQ = Wb.Worksheets("Tabelle1") Dim WsZ As Worksheet: Set WsZ = Wb.Worksheets("Tabelle2") Dim SuchA As Range: Set SuchA = WsQ.Range("E9") Dim SuchB As Range: Set SuchB = WsQ.Range("E10") Dim Wert As Range: Set Wert = WsQ.Range("N37") Dim Liste As Range, CheckKrit As Range, Wo Application.ScreenUpdating = False With WsZ Set Liste = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 43) Set CheckKrit = Liste.Offset(, 43).Resize(Liste.Rows.Count, 1) CheckKrit.FormulaR1C1 = "=RC[-43]&""-""&RC[-42]" Wo = Application.Match(SuchA.Value & "-" & SuchB.Value, CheckKrit, 0) If Not IsError(Wo) Then .Cells(Wo + 1, 43) = Wert.Value End If CheckKrit.ClearContents End With Application.ScreenUpdating = True Set Wb = Nothing: Set WsQ = Nothing: Set WsZ = Nothing Set SuchA = Nothing: Set SuchB = Nothing: Set Wert = Nothing Set Liste = Nothing: Set CheckKrit = Nothing End Sub

Guten Morgen Xenia!
Und wieder der Plattenspieler: Ich kenne Deine Produktivdatei nicht, auch nicht schematisch im Sinne einer Beispielmappe. Dh im muss mich auf Deine Angaben verlassen, und wenn Deine Angaben die Verhältnisse in der Produktivdatei nicht exakt (!) wiederspiegeln, dann kommt es zu solchen "Fehlern".
Ich bin, aufgrund Deiner letzten Infos, von der Tatsache ausgegangen, dass Deine Daten im Bereich A2:AQx stehen, wobei x die letzte gefüllte Zelle in A:A wäre. Für die Suche mit 2 Kriterien setze ich hier auf einen Trick: Ich mache aus Deinen 2 Suchwerten im Grunde genommen einen, d.h. aus "45987" und "69898" wird für die Suche "45987-69898" (mit dem Bindestrich). Dieser Wert/Begriff ist natürlich in Deiner Ziel-Tabelle nirgends vorhanden, d.h. auch hier muss ich irgendwie die durchsuchten Werte in A:A und B:B irgendwo kombiniert auflisten, um nach dem (kombinierten) Suchwert zu suchen.
Aufgrund Deiner Bereichsangabe gehe ich also davon aus, dass die auf AQ folgende Spalte (=AR) leer ist; mein Code setzt dann kurzzeitig eine Zellformel in AR2:ARx, wobei x wieder der letzten gefüllten Zelle in A:A entspricht. Diese Formel macht nichts anderes, als die jeweiligen EInträge in A2:Bx zeilenweise zu kombinieren, nach obigem Muster, also bspw. (in meiner Bsp-Mappe) [A8] "42554" und [B8] "27487" wird in [AR8] zu diesem Formelergebnis "42554-27487".
Der Code durchsucht dann die Formelegebnisse in AR2:ARx und schreibt, wenn der Suchwert gefunden wird, in die entsprechende Zeile in AQ den Ziel-Wert. Danach wird die Formel in der Hilfsspalte AR gelöscht, dh der gesamte Bereich AR2:ARx, über das von dir angesprochene .ClearContents
Auf Deine Frage bezogen: Kann man das irgendwie weglassen, also etwaige Werte in der Spalte AR stehen lassen?
Ja, wenndie Hilfsformel anstelle AR in eine andere Spalte geschrieben wird. Dh soll AR beibehalten werden, aber die Hilfsformel kurz in AS2:ASx geschrieben werden (und danach dieser Bereich gelöscht werden), dann sind folgende Anpassungen erforderlich (fett):


Set CheckKrit = Liste.Offset(, 44).Resize(Liste.Rows.Count, 1)
CheckKrit.FormulaR1C1 = "=RC[-44]&""-""&RC[-43]"

Die konkreten Änderungen im Code in Deiner Produktivdatei überlasse ich nun Dir, mit der hier beschriebenen Logik solltest Du das hinbekommen. Dies ist mein letzter Beitrag in diesem Faden.
LG Michael

Beliebteste Forumthreads (12 Monate)

Wert in Zelle per Makro, 2 Suchkriterien

15
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

306 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Wert in Zelle per Makro, 2 Suchkriterien

15 Beiträge zum Forumthread Beiträge zu diesem Forumthread

306 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

15
Beiträge zum Forumthread

Beiträge zu diesem Forumthread