Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1688to1692
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 Wert aus Spalte finden und kopieren

Makro Wert aus Spalte finden und kopieren
09.05.2019 08:44:10
Justin
Hallo liebe herber Community ich habe ein für mich schirr unlösbares Problem, welches ich seit Tagen vergeblich zu lösen versuche. Ich bin mir sicher, ich könnt mir locker helfen.
Ich habe zwei Tabellen "Meine" und "Fremde". In Tabelle Meine stehen in der Spalte A ca. 9000 Nummernwerte (13 stellige) Zahlen. Hiervon kommt jede in der Spalte A jeder Wert nur einmal vor. In der Tabelle "Fremde" stehen in Spalte a ebenfalls ca. 9000 Nummernwerte. In Spalte B stehen auch ca. 9000 Nummernwerte. Die Werte aus Spalte B sind auch 13 stellige Zahlen. Ich hätte gerne, dass mir die Tabelle Meine nun die Spalte mit der Tabelle Fremde Spalte B auf gleichheit abprüft und mir dann im Falle einer Gleichheit, die entsprechende komplette Zeile der Spalte B aus Fremde in ein neues Tabellenblatt (Result) kopiert. So weit so gut. Ich konnte mit zwei Schleifen bisher lediglich verwirklichen, dass mir der gleiche Wert aus Spalte B, aber nicht die ganze Zeile kopiert wird. Wäre echt super, könnte einer von euch mir helfen. Ich danke euch schon mal von Herzen und wünsch euch nen tollen Tag. Hier mein Code:
Dim Loletzte As Long
Dim RngZ As Range
Dim oZelle As Object
For Each oZelle In Worksheets("Meine").Range("A1:a10")
For Each RngZ In Worksheets("Fremde").Range("D1:D10")
Loletzte = Worksheets("Result").Cells(Rows.Count, 2).End(xlUp).Row + 1
If RngZ Like oZelle Then Worksheets("Result").Cells(Loletzte, 2) = RngZ
Next RngZ
Next oZelle

12
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro Wert aus Spalte finden und kopieren
09.05.2019 09:57:45
hary
Moin
"die Spalte mit der Tabelle Fremde Spalte B auf gleichheit abprüft "
wieso pruefst du dann mit:
("Fremde").Range("D1:D10")
SpalteD?
Kommt das gesuchte mehrfach vor?
Wirklich die ganze Zeile?
gruss hary
AW: Makro Wert aus Spalte finden und kopieren
09.05.2019 10:15:17
Justin
Moin hary,
Danke für deine Antwort, ich hab mich im Code verschrieben 😂. Im Code soll es natürlich in Spalte B und nicht in Spalte D heißen.
Die ganze Zeile wäre gut, mir würde aber auch die nebenliegende Spalte egal ob A oder C reichen.
AW: Makro Wert aus Spalte finden und kopieren
09.05.2019 10:39:52
Justin
Moin hary,
Danke für deine Antwort, ich hab mich im Code verschrieben 😂. Im Code soll es natürlich in Spalte B und nicht in Spalte D heißen.
Die ganze Zeile wäre gut, mir würde aber auch die nebenliegende Spalte egal ob A oder C reichen.
Anzeige
AW: Makro Wert aus Spalte finden und kopieren
09.05.2019 10:15:43
UweD
Hallo
mit nur einer Schleife; so...
Sub Meine_vergleichen()
    Dim TbM, TbF, TbR, LR As Integer, i As Integer, SP As Integer, NR As Integer
    
    Set TbM = Sheets("Meine")
    Set TbF = Sheets("Fremde")
    Set TbR = Sheets("Result")
    
    SP = 2 'Spalte B 
    
    'Reset 
    TbR.Cells.ClearContents
    
    'Überschrift kopieren 
    TbM.Rows(1).Copy TbR.Rows(1)
    
    LR = TbM.Cells(TbM.Rows.Count, SP).End(xlUp).Row 'letzte Zeile der Spalte 

    For i = 2 To LR
        If WorksheetFunction.CountIf(TbF.Columns(SP), TbM.Cells(i, SP)) > 0 Then
            'kommt in Fremde vor 
            NR = TbR.Cells(TbR.Rows.Count, SP).End(xlUp).Row + 1 'erste freie Zeile 
            
            'Zeile kopieren 
            TbM.Rows(i).Copy TbR.Rows(NR)
        End If
    Next
End Sub

LG UweD
Anzeige
AW: Makro Wert aus Spalte finden und kopieren
09.05.2019 10:22:32
Justin
Vielen Dank für die Antwort, Ihr seit die besten. Ich teste es gleich heute Nachmittag und gebe dann Bescheid.
Lg Justin
AW: Makro Wert aus Spalte finden und kopieren
09.05.2019 16:49:50
Justin
Hi UweD,
ich habe gerade dein Makro getestet. Es funzt leider ned, Excel Excel macht mir in meinem WS Result lediglich die erste Zelle aus WS Meine herein. Wie gesagt ich bräuchte ein Makro, welches mir aus Spalte A in WS Meine, jeden Wert nacheinander mit der Spalte B aus dem WS Fremde abgleicht und im Trefferfall, die gleiche Zeile in das WS Result nacheinander kopiert. Wie gesagt, das übersteigt meine VBA Fähigkeiten ;). Wäre cool, würdest du oder sonst wer eine Lösung finden. Zur besseren Lösungsfindung hänge ich mal die Excel Datei an. Vielen Dank
https://www.herber.de/bbs/user/129691.xlsm
Anzeige
AW: Makro Wert aus Spalte finden und kopieren
09.05.2019 23:24:25
Justin
Sorry ausversehen geschlossen
AW: Makro angepasst
10.05.2019 06:39:57
hary
Moin
Hab mal Uwe seinen Code angepasst.
Sub Meine_vergleichen()
Dim TbM, TbF, TbR, LR As Integer, i As Integer, SP As Integer, NR As Integer
Set TbM = Sheets("Meine")
Set TbF = Sheets("Fremde")
Set TbR = Sheets("Result")
SP = 2 'Spalte B
'Reset
TbR.Cells.ClearContents
LR = TbM.Cells(TbM.Rows.Count, 1).End(xlUp).Row 'letzte Zeile der Spalte
For i = 2 To LR
If WorksheetFunction.CountIf(TbF.Columns(SP), TbM.Cells(i, 1)) > 0 Then
'kommt in Fremde vor
NR = TbR.Cells(TbR.Rows.Count, 1).End(xlUp).Row + 1 'erste freie Zeile
'Zeile kopieren
TbM.Rows(i).Copy TbR.Rows(NR)
End If
Next
End Sub

gruss hary
Anzeige
AW: korrektur
10.05.2019 06:50:53
hary
Moin nochemal
Schleife muss natuerlich
For i = 1 To LR

bei 1 starten.
gruss hary
AW: korrektur
13.05.2019 21:17:16
Justin
Hi Hary,
vielen Dank für die Änderung. Der Code ist gut, geht auch bei ca. 9000 Datensätzen sehr schnell.
Jetzt habe ich festgestellt, dass er mir nur den Suchwert kopiert aber nicht die ganze Zeile.
Ist es vieleicht möglich, dass er mir als Ergebnis nur die Werte aus dem Sheet ("Meine"), mit der entsprechenden Zeile aus dem Sheet("Fremde") wiedergibt. Quasi eine Art Abgleich. Dh er müsste alle Werte aus ("Meine") mit allen Werten aus ("Fremde") einzeln abgleichen und bei Wertgleichheit die Zeile aus ("Fremde") kopieren?
LG Justin
Anzeige
AW: Makro angepasst
10.05.2019 08:38:38
Justin
Hary besten Dank, läuft. Ihr seit echt Hammer...
AW: schliessen vergessen oWt
13.05.2019 23:07:16
Piet

299 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige