for next schleife trotz fehlendem wert fortsetzen

Option Explicit Sub daten_import() Dim rng As Range Dim j As Integer Dim i As Date 'zu suchendes Datum Dim s As String 'Name des zu durchsuchenden Tabellenblattes Dim sPfad As String Dim lngZeile As Long Dim lngZeileMax As Long Dim wkbZiel As Workbook Set wkbZiel = ThisWorkbook With Tabelle4 For lngZeile = 1 To lngZeileMax . ' Quelldatei wird im Hintergrund geöffnet . ' das entsprechende Tabellenblatt wird ausgewählt . ' dann beginnt die Suche Set rng = ActiveSheet.Cells.Find(what:=i, lookat:=xlWhole, LookIn:=xlValues) If Not i Then MsgBox "Für" & Space(1) & (s) & Space(1) & "sind zum gesuchten Datum keine Eintragungen vorhanden" Next lngZeile

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Daten_importieren() 'In der Reihenfolge des Erscheinens: Dim AktZeile As Long Dim LetzteZeile As Long Dim Datum As Date 'zu suchendes Datum Dim DateiPfad As String Dim BlattName As String 'Name des zu durchsuchenden Tabellenblattes Dim wbkQuelle As Workbook Dim Treffer As Range With ThisWorkbook.Worksheets("Tabelle4") LetzteZeile = .UsedRange.spcialcells(xlCellTypeLastCell).Row On Error Resume Next For AktZeile = 1 To LetzteZeile Datum = .Cells(AktZeile, "C").Value DateiPfad = .Cells(AktZeile, "D").Value BlattName = .Cells(AktZeile, "E").Value Set wbkQuelle = Workbooks.Open(DateiPfad) Set Treffer = Nothing Set Treffer = wbkQuelle.Worksheets(BlattName).Find(what:=Datum, lookat:=xlWhole, LookIn:=xlValues) If Treffer Is Nothing Then MsgBox "Für " & BlattName & " sind zum gesuchten Datum keine Eintragungen vorhanden" Else .Cells(AktZeile, "G").Resize(1, 5).Value = Treffer.EntireRow.Range("G1:K1").Value End If wbkQuelle.Close Next AktZeile End With End Sub

Guten Abend,

allen Tippgebern erstmal vielen Dank dafür und entschuldigt bitte, dass ich erst jetzt dazu komme, euch zu antworten.
Ich habe letztendlich aus allen Tipps das für mich am besten passende oder im Fall von Yal, was ich am ehesten nachvollziehen konnte, in meinen Code eingebaut.
Der Tipp von Onur, das öffne der Quelldatei vor der Schleife auszuführen ist eigentlich total logisch und hat die Laufzeit des Makros signifikant verkürzt. Durch diese neue Geschwindigkeit kommt es jedoch zu einem sehr schnellen flackern des Bildschirms während das Makro läuft. Hat jemand eine Idee, wie man das abstellen kann?
Anbei nun den kompletten Code und vielen Dank schonmal fürs nachdenken (die ganzen Kommentierungen sind eher für mich, um den Code auch nach längerer Zeit nachvollziehen zu können)

Sub Daten_Import()

 

Dim Treffer As Range

Dim Hilfswert As Integer

Dim Datum As Date

Dim BlattName As String

Dim DateiPfad As String

Dim DateiName As String

Dim AktZeile As Long

Dim letzteZeile As Long

Dim wkbQuelle As Workbook



'Quelldatei

DateiPfad = "C:\...\...\...\"

DateiName = "........."



With Tabelle4 'Hilfstabelle



'bisherige Einträge löschen

 .Range("A1:N75").ClearContents

  'Öffnen der Quelldatei im Hintergrund

   Set wkbQuelle = Workbooks.Open(DateiPfad & DateiName)

   Application.ScreenUpdating = False

   Application.DisplayAlerts = False

   letzteZeile = .UsedRange.Rows.Count 'letzte benutzte Zeile der Zieldatei (Hilfstabelle)

   'bei fehlenden Werten die Suche fortsetzen

   On Error Resume Next

   For AktZeile = 1 To letzteZeile 'festlegen der Schleife (von der ersten Zeile bis zur letzten benutzten Zeile)

      'Hilfswert zum Beenden der Schleife, wenn keine Daten in Hilfstabelle vorhanden sind

      Hilfswert = .Cells(AktZeile, 22).Value

      If Hilfswert = 1 Then

        Workbooks(DateiName).Close SaveChanges:=False

        Exit Sub

      Else

        BlattName = .Cells(AktZeile, 20).Value 'Name des Tabellenblattes in der Quelldatei, in dem die Daten gesucht werden sollen

        Datum = .Cells(AktZeile, 21).Value 'Datum nach dem gesucht werden soll

        'in dem den aktuellen Suchparametern entsprechenden Tabellenblatt nach dem Datum suchen

        Set Treffer = Worksheets(BlattName).Cells.Find(what:=Datum, lookat:=xlWhole, LookIn:=xlValues)

        If Treffer Is Nothing Then

          MsgBox "Für den " & Datum & " sind bei " & BlattName & " keine Daten vorhanden"

        Else

          'zum gesuchten Datum gehörenden Bereich, kopieren

          Treffer.Columns("B:O").Copy

          'und in der Zieldatei (Hilfstabelle) in der den Suchparametern entsprechenden Zeile eintragen

          ThisWorkbook.Sheets("Hilfstabelle").Cells(AktZeile, 1).PasteSpecial xlPasteValues

        End If

        'Zwischspeicher leeren

        Application.CutCopyMode = False

      End If

  'Suche mit den nächsten Parametern aus Zieldatei (Hilfstabelle) fortsetzen

  Next AktZeile

'Quelldatei schließen ohne zu speichern

Workbooks(DateiName).Close SaveChanges:=False

End With

End Sub

Beliebteste Forumthreads (12 Monate)

for next schleife trotz fehlendem wert fortsetzen

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

for next schleife trotz fehlendem wert fortsetzen

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread