Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 19:29:30
24.04.2024 18:49:56
24.04.2024 17:19:09
Anzeige
Archiv - Navigation
1536to1540
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Makro Tabelle durchsuchen

Makro Tabelle durchsuchen
06.02.2017 18:45:44
Marc
Hallo,
vielleicht kann mir hier jemand helfen.
Ich habe folgenden Fall: ich habe eine Excel-Datei mit einigen Tabellenblättern (im Beispiel Tabelle 1 und 2). In jedem Blatt stehen Positionen mit Nummern.
Ich habe dann noch eine weitere Tabelle (Tabelle3) mit Positionen und Werten, die aus einer anderen Datenquelle stammen. Auch diese Positionen haben Nummern, aber andere als in Tabelle 1 und 2.
Mit einer Matching-Tabelle kann ich nun die Nummern zuordnen.
Nun wäre es super, wenn die Beträge automatisch in die Tabellen 1 und 2 geschrieben werden könnten. Also sprich, das Makro soll die Tabellen 1 und 2 durchsuchen, nach den Nummern suchen und dann anhand der Matching-Tabelle die Werte eintragen. Hoffe das war verständlich.
Habe auch eine Beispieldatei angehängt.
https://www.herber.de/bbs/user/111256.xlsx
Danke und viele Grüße
Marc

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro Tabelle durchsuchen
06.02.2017 20:29:11
Piet
Hallo Marc
anbei ein Makro Code mit dem die Nummern 9001 aus der matching Tabelle in Tabelle 1+2 Spalte E kopiert werden. Ich hoffe ich habe die Aufgabe richtig verstanden. Wenn die Sache erledigt ist Thread bitte schliessen. (Kontrollbox nicht aktivieren!!)
mfg Piet

Option Explicit      '4.2.2017  Piet  Herber Forum
Dim TB1 As Worksheet, lz1 As Long
Dim TB2 As Worksheet, lz2 As Long
Dim MTB As Worksheet, lz3 As Long
Sub Matching_übertragen()
Dim AC As Object, j, lz As Long
Set TB1 = Worksheets("Tabelle1")
Set TB2 = Worksheets("Tabelle2")
Set MTB = Worksheets("Matching-Tabelle")
lz1 = TB1.Range("A1").End(xlDown).Row
lz2 = TB2.Range("A1").End(xlDown).Row
lz3 = MTB.Range("A1").End(xlDown).Row
If lz1 > lz2 Then lz = lz1 Else lz = lz2
For Each AC In MTB.Range("A2:A" & lz3)
For j = 2 To lz
If TB1.Cells(j, 1) = AC.Value Then
TB1.Cells(j, "E") = AC.Cells(1, 2)
End If
If TB2.Cells(j, 1) = AC.Value Then
TB2.Cells(j, "E") = AC.Cells(1, 2)
End If
Next j
Next AC
End Sub

Anzeige
AW: Makro Tabelle durchsuchen
07.02.2017 11:00:43
Marc
Hat mir beides sehr geholfen! Vielen Dank euch zwei!

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige