Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

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)
Antworten 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
Antworten 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?
Antworten 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
Antworten Top
#5
danke! ich geb dann morgen rückmeldung  Blush
Antworten 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. :/
Antworten Top
#7
Hallo,

ersetze Worksheets durch Range.

Gruß Uwe
[-] Folgende(r) 1 Nutzer sagt Danke an Kuwer für diesen Beitrag:
  • helix
Antworten Top
#8
(18.05.2017, 15: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
Antworten 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
Antworten Top
#10
super klappt danke!
Antworten Top


Gehe zu:


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