VBA Makro Suchen/ersetzen
#1
Guten Morgen zusammen,
ich soll kurzfristig für meinen Chef eine sich selbstaktualisierende Excel Tabelle basteln, die sich ihre Daten selbstständig aus Excel SAP-Export Tabellen zieht und für eine Pivot-Tabelle vorbereitet.
Soweit habe ich, ohne jegliche VBA-Erfahrung, den Großteil umsetzen können. Nur an 2 Problemen bin ich leider gescheitert. Große Problem war die schiere Masse der durchzuarbeitende Daten (Blatt 1 ca. 15.000 Zeilen, Spalten A bis O ;variiert), Blatt 2 (ca. 2.500 Zeilen, Spalte A bis D; variiert).
Habe schon stundenlang Google bemüht, habe aber leider nichts wirklich passendes finden können. Ich hoffe hier kann man mir weiterhelfen. Und wenn wer ein gutes Buch/Seite kennt um das Programmieren in VBA zu lernen wäre ich auch dankbar. ^^
Dann danke ich schonmal für eure Hilfe und hier die beiden Probleme:

Problem 1:

Wenn eine Zelle aus einer bestimmter Spalte (N) auf Blatt 1 leer,
dann Eintrag "leer" in gleicher Zeile ,aber Spalte B vornehmen,
Wenn nicht leer (irgendein Inhalt vorhanden),
dann anderen Eintrag in gleicher Zeile "voll" vornehmen (gleiche Zelle wie bei voll)
Anzahl der Gesamtzeilen variiert hier.



Problem 2:

Inhalt in einer bestimmten spalte in Blatt 2 abgleichen,  ob gleicher Eintrag auf Blatt in einer bestimmten spalte vorhanden,
wenn ja 2 Zellen aus der gleichen Zeile auf Blatt 2 in die gleiche Zeile auf Blatt 1 eins übernehmen, wo der Eintrag gefunden wurde,
wenn nein zur nächsten Zeile in Blatt 2 springen.
Wiederholen bis alle Einträge auf Blatt 2 abgearbeitet sind
(Anzahl der Einträge variiert auch hier)
Top
#2
Hallo,

zu Problem 2

Code:
'bei einmaligen Treffern
Sub prcFinden()
    Dim rngTreffer As Range
    Dim lngC As Long
    
    'dein Blatt2 Namen bitte anpassen
    With Worksheets("Tabelle2")
        'eine Schleife über die Spalte A des Blatts2
        For lngC = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
            'gesucht wird in der Spalte A vom Blatt1 der Wert aus der Spalte A... vom Blatt2
            Set rngTreffer = Worksheets("Tabelle1").Columns(1).Find(.Cells(lngC, 1), lookat:=xlWhole, LookIn:=xlValues)
            'wenn es gefunden wird
            If Not rngTreffer Is Nothing Then
                'kopiere Spalte C und D vom Blatt2 ins Blatt1 Spalte C und D
                .Cells(lngC, 3).Resize(, 2).Copy Worksheets(rngTreffer.Row, 3)
            End If
        Next lngC
    End With

End Sub
Gruß Stefan
Win 10 / Office 2016
[-] Folgende(r) 1 Nutzer sagt Danke an Steffl für diesen Beitrag:
  • helix
Top
#3
Super, danke! Werde ich morgen auf der Arbeit direkt einfügen. 
Wie müsste ich den Code anpassen, wenn mehrere Treffer möglich sind?
Top
#4
Hallo,

ist ungetestet

Code:
'bei mehreren möglichen Treffern
Sub prcFinden()
    Dim rngTreffer As Range
    Dim lngC As Long
    Dim strAdresse As String
    
    'dein Blatt2 Namen bitte anpassen
    With Worksheets("Tabelle2")
        'eine Schleife über die Spalte A des Blatts2
        For lngC = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
            'gesucht wird in der Spalte A vom Blatt1 der Wert aus der Spalte A... vom Blatt2
            Set rngTreffer = Worksheets("Tabelle1").Columns(1).Find(.Cells(lngC, 1), lookat:=xlWhole, LookIn:=xlValues)
            'wenn es gefunden wird
            If Not rngTreffer Is Nothing Then
                strAdresse = rngTreffer.Address
                Do
                    'kopiere Spalte C und D vom Blatt2 ins Blatt1 Spalte C und D
                    .Cells(lngC, 3).Resize(, 2).Copy Worksheets(rngTreffer.Row, 3)
                    Set rngTreffer = Worksheets("Tabelle1").Columns(1).FindNext(rngTreffer)
                Loop While strAdresse <> rngTreffer.Address
            End If
        Next lngC
    End With

End Sub
Gruß Stefan
Win 10 / Office 2016
[-] Folgende(r) 1 Nutzer sagt Danke an Steffl für diesen Beitrag:
  • helix
Top
#5
danke! ich geb dann morgen rückmeldung  Blush
Top
#6
Habe gerade das Makro getestet und kriege direkt folgende Fehlermeldung: "Fehler beim Kompilieren; falsche anzahl an argmenten oder ungültige Zuweisung zu einer Eigenschaft"

bei der zeile(markiert wird worksheets)

                    .Cells(lngC, 3).Resize(, 2).Copy Worksheets(rngTreffer.Row, 3)

Habs versucht selber umzustellen ändert, aber leider höchstens die Fehlermeldung ab. :/
Top
#7
Hallo,

ersetze Worksheets durch Range.

Gruß Uwe
[-] Folgende(r) 1 Nutzer sagt Danke an Kuwer für diesen Beitrag:
  • helix
Top
#8
(18.05.2017, 16:26)Kuwer schrieb: Hallo,

ersetze Worksheets durch Range.

Gruß Uwe

Dann kommt leider: "Laufzeitfehler "1004": Die Methode "range" für das objekt "_global" ist fehlgeschlagen
Top
#9
Hallo,

statt:


Code:
Worksheets(rngTreffer.Row, 3)

sollte es so lauten:

Code:
Worksheets("Tabelle1").Cells(rngTreffer.Row, 3)
Gruß Atilla
[-] Folgende(r) 2 Nutzer sagen Danke an atilla für diesen Beitrag:
  • Steffl, helix
Top
#10
super klappt danke!
Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste