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.

Excel VBA-Code optimieren
#1
Hallo zusammen

hab folgenden Code geschrieben, siehe angehängte Datei, es werden zwei Tabellen verglichen und die fehlenden Daten in Tabelle 1 geschrieben, soweit funktioniert der Code, aber bei größeren Daten (ca. 10000 Zeilen) läuft der Code extrem lang.
Nun bin ich auf der Suche ob mir jemand Helfen kann diesen Code zu optimieren, wäre für die Hilfe sehr Dankbar.

Gruß

Flado


Angehängte Dateien
.xlsm   Tabellevergleich_fehlende Werte übertragen.xlsm (Größe: 16,69 KB / Downloads: 4)
Antworten Top
#2
Hallo,

in deiner Beispieldatei ist in der Tabelle2 ein Auftragswert doppelt vorhanden. Die unterscheiden sich nur durch die weiteren Spalten. Was soll in solchen Fällen geschehen?

Code:
Sub prcTreffer()
   Dim lngC As Long
   Dim rngTreffer As Range
   Dim strAdresse As String
    
   With Worksheets("Tabelle2")
      For lngC = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
         Set rngTreffer = Worksheets("Tabelle1").Columns(1).Find(.Cells(lngC, 1), LookIn:=xlValues, lookat:=xlWhole)
         If Not rngTreffer Is Nothing Then
            strAdresse = rngTreffer.Address
            Do
               If IsEmpty(rngTreffer.Offset(, 2).Value) Then .Cells(lngC, 2).Resize(, 2).Copy rngTreffer.Offset(, 2)
               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
Antworten Top
#3
Hallo

das war mein Fehler Auftragsnummer können in der Liste die wo ich bearbeite nicht vorkommen, muss deswegen nicht berücksichtig werden.

Danke für den Code werden ich dann mal Testen.

Gruß

Michael
Antworten Top
#4
Hallo Michael,

ich interpretiere mal das der Satz

Zitat:doppelte Auftragsnummer können in der Liste die wo ich bearbeite nicht vorkommen

hätte lauten sollen. Da brauche ich dann nicht mehr die zusätzlichen Abfragen zu machen und kürze den Code ein wenig.

Code:
Sub prcTreffer()
   Dim lngC As Long
   Dim rngTreffer As Range
    
   With Worksheets("Tabelle2")
      For lngC = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
         Set rngTreffer = Worksheets("Tabelle1").Columns(1).Find(.Cells(lngC, 1), LookIn:=xlValues, lookat:=xlWhole)
         If Not rngTreffer Is Nothing Then
            .Cells(lngC, 2).Resize(, 2).Copy rngTreffer.Offset(, 2)
         End If
      Next lngC
   End With
End Sub
Gruß Stefan
Win 10 / Office 2016
Antworten Top


Gehe zu:


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