Loop / mehrere Ergebnisse

Bewerten Sie hier bitte das Excel-Portal

Der kurze Weg zum Ziel: Auftragsprogrammierung

Loop / mehrere Ergebnisse

Loop / mehrere Ergebnisse von Hauke vom 26.09.2019 14:27:29

AW: Loop / mehrere Ergebnisse - von Piet am 26.09.2019 20:18:55

Betrifft: Loop / mehrere Ergebnisse von: Hauke
Geschrieben am: 26.09.2019 14:27:29

Hallo zusammen,

kann mir evtl. jemand sagen, wie ich alle Ergebnisse aus der folgenden Anfrage erhalte?
Aktuell läuft der Prozess einmal durch und macht das was er soll. Allerdings gibt es mehrere Ergebnisse.

Ausgang: 2 Dateien, beide sind geöffnet. Aktualisierung Datei 1 erfolgt täglich. Über das Script soll Datei 2 ein Update erfahren.

Ist ein gleicher Wert (Nur zahlen) in der Spalte E der Datei 1 und 2 enthalten, soll nur die Spalte D der gleichen Zeile von 1 nach 2 übertragen werden.

Wird ein Wert aus Datei 1 Spalte E, nicht in Datei 2 Spalte E gefunden, soll die komplette Zeile aus Datei 1 in die erste freie Spalte in Datei 2 kopiert werden.

Aktueller Stand:

   Application.ScreenUpdating = False
   On Error Resume Next
   Set wkb = Workbooks.Open(Filename:=my_FileName)
   Set wkb1 = ThisWorkbook
   wkb1.Activate
   Set wks = wkb.Worksheets(1)
   Set wks1 = wkb1.Worksheets(1)
   anz = wks.Cells(65536, 5).End(xlUp).Row
   anz1 = wks1.Cells(65536, 5).End(xlUp).Row
   For Z = 2 To anz1
    suchwert = wks1.Cells(Z, 5)
    With wks.Range("E2:E" & anz)
    Set c = .Find(suchwert, LookIn:=xlValues, LookAt:=xlWhole)
    If Not c Is Nothing Then
        For s = 4 To 5
            wks.Cells(c.Row, s) = wks1.Cells(Z, s)
            Next
        Else
        For s = 1 To 9
            wks.Cells(anz + 1, s) = wks1.Cells(Z, s)
            Next
        anz = wks.Cells(65536, 1).End(xlUp).Row
    End If
    End With
    Next
   Application.ScreenUpdating = True

Hat jemand eine Idee?

Danke und LG,
Hauke

Betrifft: AW: Loop / mehrere Ergebnisse von: Piet
Geschrieben am: 26.09.2019 20:18:55

Hallo Hauke

ich schicke dir deinen Code in bisschen überarbeitet zurück.
Statt wks.Cells(65536, 5).End(xlUp).Row nimmst du besser Rows.Count, dann laeuft er auch ab Exel 2007 oder höher.
Mir ist etwas wichtiges aufgefallen, vielleicht ist das dein Fehler. Das musst du bitte selbst prüfen!
Ich habe diesen Teil VOR For Next gestellt, dann kannst du auf wks.Cells(anz + 1, S) in der Schleife verzichten.

Dabei fiel mir auf das du oben anz in der Spalte 5 suchst, in der For Next Schleife aber in Spalte 1. Ist das richtig???

mfg Piet

Sub Test()
   Application.ScreenUpdating = False
   On Error Resume Next
   Set wkb = Workbooks.Open(Filename:=my_FileName)
   Set wkb1 = ThisWorkbook
   wkb1.Activate
   Set wks = wkb.Worksheets(1)
   Set wks1 = wkb1.Worksheets(1)
   anz = wks.Cells(Rows.Count, 5).End(xlUp).Row
   anz1 = wks1.Cells(Rows.Count, 5).End(xlUp).Row
   For z = 2 To anz1
    suchwert = wks1.Cells(z, 5)
    With wks.Range("E2:E" & anz)
    Set c = .Find(suchwert, LookIn:=xlValues, LookAt:=xlWhole)
    If Not c Is Nothing Then
         wks.Cells(c.Row, 4) = wks1.Cells(z, 4)
         wks.Cells(c.Row, S) = wks1.Cells(z, S)
        Else
        anz = wks.Cells(Rows.Count, 1).End(xlUp).Row
        For S = 1 To 9
            wks.Cells(anz, S) = wks1.Cells(z, S)
            Next
    End If
    End With
    Next
End Sub