Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA - Suche von Zellinhalt und einfügen von Zeilen

VBA - Suche von Zellinhalt und einfügen von Zeilen
10.09.2018 14:34:46
Zellinhalt
Hallo zusammen,
ich lese nun schon seit einiger Zeit hier im Forum mit und bin von eurer Hilfsbereitschaft echt begeistert. Ich beschäftige mich noch nicht so lange mit VBA und bin nun auf ein Problem gestoßen bei dem ich ohne Hilfe leider nicht weiterkomme. Erfolglos gesucht habe ich bereits.
Ich habe zwei Tabellen. Die Nummer aus Tabelle 1 soll in Tabelle 2 gesucht werden. Da die Nummer in Tabelle 2 öfters vorkommt sollen alle Treffer untereinander in Tabelle 3 ausgegeben und der Inhalt von Tabelle 1 und Tabelle 2 konsolidiert werden (wie 1a, 2a) und dann nach der nächsten Nummer gesucht werden. Wenn die Nummer nicht in Tabelle 2 vorkommt, soll nur der Inhalt von Tabelle 1 ausgegeben werden. (wie 3a)
Kommt in Tabelle 2 eine Nummer vor, die nicht in Tabelle 1 vorkommt, dann soll diese in Tabelle 4 wiedergegeben werden. Tabelle 1-4 ist jeweils 1 Worksheet. In der Realität bestehen die Tabellen aus mehreren Spalten als hier angegeben.
Nachdem ich übers Wochenende endlos rumprobiert und gesucht habe bin ich mittlerweile echt ratlos. Eigentlich kann das ja nicht so schwer sein. Könnt ihr mir weiterhelfen?
Tabelle1:
Nr: Name:
1a abc
1b abc
2a def
3a ghi
3b ghi
Tabelle 2:
Nr: Wert:
1a 111
1a 222
1b 333
2a 444
2a 555
3c 777
Tabelle3:
Nr: Name: Wert:
1a abc 111
1a abc 222
1b abc 333
2a def 444
2a def 555
3a ghi
3b ghi
Tabelle4:
Nr: Name: Wert:
3c ghi 777

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA - Suche von Zellinhalt und einfügen von Zeilen
10.09.2018 16:35:53
Zellinhalt
Ich gehe mal von aus, dass jeder Wert in einer separaten Spalte steht. Also Nr. ist ein Spalte, Name ist eine Spalte und Wert ebenfalls?
AW: VBA - Suche von Zellinhalt und einfügen von Zeilen
10.09.2018 20:44:54
Zellinhalt
Hallo, ja genau. Entschuldige bitte die schlechte Darstellung. Kannst du mir bei dem Problem helfen?
AW: VBA - Suche von Zellinhalt und einfügen von Zeilen
11.09.2018 10:33:24
Zellinhalt

Option Explicit
Sub TabellenKonsolidieren()
Dim ArrayTab1, ArrayTab2 As Variant
Dim ArrayConsolidated()
Dim i, x As Integer
Dim Tab1, Tab2, Tab3, Tab4 As Worksheet
Set Tab1 = ThisWorkbook.Sheets(1)
Set Tab2 = ThisWorkbook.Sheets(2)
Set Tab3 = ThisWorkbook.Sheets(3)
Set Tab4 = ThisWorkbook.Sheets(4)
ArrayTab1 = Tab1.Range("A2:B" & Tab1.Cells(Rows.Count, 2).End(xlUp).Row)
ArrayTab2 = Tab2.Range("A2:B" & Tab2.Cells(Rows.Count, 2).End(xlUp).Row)
For i = LBound(ArrayTab1, 1) To UBound(ArrayTab1, 1)
For x = LBound(ArrayTab2, 1) To UBound(ArrayTab2, 1)
If ArrayTab1(i, 1) = ArrayTab2(x, 1) Then
Sheets(3).Cells(x + 1, 1) = ArrayTab1(i, 1)
Sheets(3).Cells(x + 1, 2) = ArrayTab1(i, 2)
Sheets(3).Cells(x + 1, 3) = ArrayTab2(x, 2)
End If
Next x
Next i
'Fehlende Nr in Tab2 in Tab3 eintragen
Dim LastRow As Integer
Dim NrFinden, SucheTab1, SucheTab2 As Range
Dim r As Range
Set SucheTab2 = Tab2.Range("A1", Tab2.Range("A1").End(xlDown))
Set SucheTab1 = Tab1.Range("A1", Tab1.Range("A1").End(xlDown))
For Each r In Tab1.Range("A2", Tab1.Range("A1").End(xlDown))
Set NrFinden = SucheTab2.Find(r)
LastRow = Tab3.Cells(Rows.Count, 1).End(xlUp).Row + 1
If NrFinden Is Nothing Then
Tab3.Cells(LastRow, 1) = r
Tab3.Cells(LastRow, 2) = r.Offset(0, 1)
End If
Next r
'Fehlende Nr in Tab1 in Tab4 eintragen
For Each r In Tab2.Range("A2", Tab2.Range("A1").End(xlDown))
Set NrFinden = SucheTab1.Find(r)
LastRow = Tab4.Cells(Rows.Count, 1).End(xlUp).Row + 1
If NrFinden Is Nothing Then
Tab4.Cells(LastRow, 1) = r
Tab4.Cells(LastRow, 3) = r.Offset(0, 1)
End If
Next r
End Sub

Anzeige
AW: VBA - Suche von Zellinhalt und einfügen von Zeilen
12.09.2018 10:05:50
Zellinhalt
Hallo Rob, hallo Piet
vielen lieben Dank für eure Codes. Nach kurzer Anpassung auf meinen richtigen Anwendungsfall haben mich diese zum Ziel gebracht. Danke nochmals.
Viele Grüße
Jantje
AW: VBA - Suche von Zellinhalt und einfügen von Zeilen
11.09.2018 03:17:33
Zellinhalt
Hallo
hier ein Code mit 3 Schleifen. Er müsste funktionieren
mfg Piet
Option Explicit
Sub Daten_konsolidieren()
Dim Tb1 As Worksheet
Dim Tb2 As Worksheet
Dim Tb4 As Worksheet
Dim t As Long, n As Long
Dim lz1 As Long, lz2 As Long
Dim AC As Range, AJ As Range
Set Tb1 = Worksheets("Tabelle1")
Set Tb2 = Worksheets("Tabelle2")
Set Tb4 = Worksheets("Tabelle4")
lz1 = Tb1.Cells(Rows.Count, 1).End(xlUp).Row
lz2 = Tb2.Cells(Rows.Count, 1).End(xlUp).Row
With Worksheets("Tabelle3")
'LatZell in Tabelle 1+2 suchen
lz1 = Tb1.Cells(Rows.Count, 1).End(xlUp).Row
lz2 = Tb2.Cells(Rows.Count, 1).End(xlUp).Row
'Tabelle 3+4 Bereich löschen
n = .Cells(Rows.Count, 1).End(xlUp).Row + 1
t = Tb4.Cells(Rows.Count, 1).End(xlUp).Row + 1
.Range("A2:C" & n).Clear
Tb4.Range("A2:C" & t).Clear
t = 2  '1.Zeile in Tab.3 setzen
'1.Schleife für Werte in Tabelle1 + 2 suchen
For Each AC In Tb1.Range("A2:A" & lz1)
For Each AJ In Tb2.Range("A2:A" & lz2)
If AC.Value = AJ.Value Then
.Cells(t, 1) = AC.Value
.Cells(t, 2) = AC.Cells(1, 2)
.Cells(t, 3) = AJ.Cells(1, 2)
t = t + 1: n = n + 1
End If
Next AJ
Next AC
'2.Schleife in Tabelle1 Name ohne Werte suchen
For Each AC In Tb1.Range("A2:A" & lz1)
n = 0  'Werte Zaehler löschen
For Each AJ In Tb2.Range("A2:A" & lz2)
If AC.Value = AJ.Value Then _
n = n + 1: Exit For
Next AJ
'Name ohne Wert notieren
If n = 0 Then
.Cells(t, 1) = AC.Value
.Cells(t, 2) = AC.Cells(1, 2)
t = t + 1
End If
Next AC
t = 2  '1.Zeile in Tab.4 setzen
'3.Schleife in Tabelle2 Wert ohne Name suchen
For Each AC In Tb2.Range("A2:A" & lz2)
n = 0  'Werte Zaehler löschen
For Each AJ In Tb1.Range("A2:A" & lz1)
If AC.Value = AJ.Value Then _
n = n + 1: Exit For
Next AJ
'Wert ohn Name notieren
If n = 0 Then
Tb4.Cells(t, 1) = AC.Value
Tb4.Cells(t, 3) = AC.Cells(1, 2)
t = t + 1
End If
Next AC
End With
MsgBox "Ende"
End Sub

Anzeige

340 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige