VBA Suche funktioniert nur einmal nach dem Öffnen

Question

Ich habe ein Makro, das die Suche nach einem Datum in einem dynamischen Bereich beinhaltet.

Wenn ich die Arbeitsmappe schließe und wieder öffne, funktioniert es gut. Wenn ich jedoch versuche, das gleiche Makro ein zweites, drittes oder viertes Mal auszuführen, gibt der Abschnitt, in dem ich nach "z" suche, Nothing für "z" zurück, obwohl die Suchvariable ("x") als korrekt definiert ist Datum, ein entsprechendes Datum existiert in dem Bereich und der Bereich wird richtig definiert.

Diese Frage wurde zuvor gestellt und beantwortet, und bei dieser Gelegenheit bestand das Problem darin, dass das OP kein "LookIn" enthielt. Ich habe jedoch.

Es schlägt auf der Linie set z = .Find (x, Lookin:= xlValues) - dies gibt Nothing zurück.

Sub Calculate_Nights_days() 
    'Application.ScreenUpdating = False 

    Dim Ws As Worksheet 
    Dim starting_ws As Worksheet 
    Dim StartDate As Date 
    Dim EndDate As Date 
    Dim crng As Range 
    Dim sValue As Date 
    Dim sRng As Range 
    Dim lastrow As Long 
    Dim v As Integer 
    Dim WsT As Worksheet 
    Dim lastrowTotals As Long 
    Dim WsTDateRange As Range 

    Set WsT = Worksheets("Totals") 

    'Nights 
    lastrowTotals = WsT.Cells(WsT.Rows.Count, "A").End(xlUp).Row 
    If lastrowTotals > 1 Then 
     WsT.Range("A2:A" & lastrowTotals).ClearContents 
     WsT.Range("B2:B" & lastrowTotals).ClearContents 
     WsT.Range("C2:C" & lastrowTotals).ClearContents 
    Else 
    End If 

    Set starting_ws = ActiveSheet 

    For Each Ws In Workbooks("Nights and Days").Worksheets 
     If Ws.Name <> "Totals" Then 
      Ws.Activate 

      lastrow = Ws.Cells(Ws.Rows.Count, "A").End(xlUp).Row 
      Set crng = Ws.Range("A2:A" & lastrow) 

      EndDate = Application.Max(crng) 
      StartDate = Application.Min(crng) 

      For x = StartDate To EndDate 
       v = 0 

       For Each y In crng 
        If y = x And y.Offset(0, 2).Value = "Night" Then 
         v = v + 1 
        End If 
       Next y 

       If WorksheetFunction.CountA(WsT.Range("A:A")) = 0 Then 
        WsT.Range("A2").Value = x 
        WsT.Range("B2").Value = v 
       Else 
        lastrowTotals = WsT.Cells(WsT.Rows.Count, "A").End(xlUp).Row 
        WsT.Range("A" & lastrowTotals).Offset(1, 0).Value = x 
        WsT.Range("A" & lastrowTotals).Offset(1, 1).Value = v 
       End If 
      Next x 
     Else 
     End If   
    Next 


    'Days 
    lastrowTotals = WsT.Cells(WsT.Rows.Count, "A").End(xlUp).Row 

    For Each Ws In Workbooks("Nights and Days").Worksheets 
     If Ws.Name <> "Totals" Then 
      Ws.Activate 

      lastrow = Ws.Cells(Ws.Rows.Count, "A").End(xlUp).Row 
      Set crng = Ws.Range("A2:A" & lastrow) 

      EndDate = Application.Max(crng) 
      StartDate = Application.Min(crng) 

      For x = StartDate To EndDate 
       v = 0 

       For Each y In crng 
        If y = x And y.Offset(0, 2).Value = "Day" Then 
         v = v + 1 
        End If 
       Next y 

       If WorksheetFunction.CountA(WsT.Range("A:A")) = 0 Then 
        WsT.Range("A2").Value = x 
        WsT.Range("C2").Value = v 
       Else 
        lastrowTotals = WsT.Cells(WsT.Rows.Count, "A").End(xlUp).Row 
        Set WsTDateRange = WsT.Range("A2:A" & lastrowTotals) 

        With WsTDateRange 
         Set z = .Find(x, LookIn:=xlValues) 
         If Not z Is Nothing Then 
          firstAddress = z.Address 
          Do 
           z.Offset(0, 2).Value = v 
           Set z = .FindNext(z) 
           If z Is Nothing Then 
            GoTo DoneFinding 
           End If 
          Loop While z Is Nothing And z.Address <> firstAddress 
         End If 
DoneFinding: 
        End With 
       End If 
      Next x 
     Else 
     End If 
    Next 

    WsT.Activate 

    Range("A2:A" & lastrowTotals).NumberFormat = "dd/mm/yyyy" 
    Range("B2:B" & lastrowTotals).NumberFormat = "General" 
    Range("C2:C" & lastrowTotals).NumberFormat = "General" 

    WsT.Range("A2:C50000").CurrentRegion.Sort WsT.Range("A2"), xlAscending 

    'Application.ScreenUpdating = True 

End Sub 

Answer 1

In der Regel sollten Sie immer Option Explicit verwenden, um sicher zu stellen, dass alle Ihre Variablen deklariert, korrekt und Tippfehler werden keine Fehler zur Laufzeit führen.

Als zweiten Punkt - versuchen Sie, ein bisschen Ihren Code zu formatieren, zu viele leere Zeilen und schlechte Einrückung ist ein bisschen nicht verständlich. Sehen Sie sich den folgenden Code an und kopieren Sie ihn auf Ihre Frage.

Option Explicit 

Sub Calculate_Nights_days() 

    Dim Ws      As Worksheet 
    Dim starting_ws    As Worksheet 
    Dim StartDate    As Date 
    Dim EndDate     As Date 
    Dim crng     As Range 
    Dim sValue     As Date 
    Dim sRng     As Range 
    Dim lastrow     As Long 
    Dim v      As Long 
    Dim WsT      As Worksheet 
    Dim lastrowTotals   As Long 
    Dim WsTDateRange   As Range 
    Dim x      As Long 
    Dim y      As Range 
    Dim z      As Range 
    Dim firstAddress   As String 

    Set WsT = Worksheets("Totals") 
    lastrowTotals = WsT.Cells(WsT.Rows.Count, "A").End(xlUp).Row 

    If lastrowTotals > 1 Then 

     WsT.Range("A2:A" & lastrowTotals).ClearContents 
     WsT.Range("B2:B" & lastrowTotals).ClearContents 
     WsT.Range("C2:C" & lastrowTotals).ClearContents 

    End If 

    Set starting_ws = ActiveSheet 

    For Each Ws In Workbooks("Nights and Days").Worksheets 
     If Ws.Name <> "Totals" Then 
      Ws.Activate 
      lastrow = Ws.Cells(Ws.Rows.Count, "A").End(xlUp).Row 
      Set crng = Ws.Range("A2:A" & lastrow) 

      EndDate = Application.Max(crng) 
      StartDate = Application.Min(crng) 

      For x = StartDate To EndDate 
       v = 0 
       For Each y In crng 
        If y = x And y.Offset(0, 2).Value = "Night" Then 
         v = v + 1 
        End If 
       Next y 

       If WorksheetFunction.CountA(WsT.Range("A:A")) = 0 Then 
        WsT.Range("A2").Value = x 
        WsT.Range("B2").Value = v 
       Else 


        lastrowTotals = WsT.Cells(WsT.Rows.Count, "A").End(xlUp).Row 
        WsT.Range("A" & lastrowTotals).Offset(1, 0).Value = x 
        WsT.Range("A" & lastrowTotals).Offset(1, 1).Value = v 
       End If 
      Next x 
     End If 
    Next 


    lastrowTotals = WsT.Cells(WsT.Rows.Count, "A").End(xlUp).Row 

    For Each Ws In Workbooks("Nights and Days").Worksheets 
     If Ws.Name <> "Totals" Then 
      Ws.Activate 
      lastrow = Ws.Cells(Ws.Rows.Count, "A").End(xlUp).Row 
      Set crng = Ws.Range("A2:A" & lastrow) 
      EndDate = Application.Max(crng) 
      StartDate = Application.Min(crng) 

      For x = StartDate To EndDate 
       v = 0 
       For Each y In crng 
        If y = x And y.Offset(0, 2).Value = "Day" Then 
         v = v + 1 
        End If 
       Next y 

       If WorksheetFunction.CountA(WsT.Range("A:A")) = 0 Then 
        WsT.Range("A2").Value = x 
        WsT.Range("C2").Value = v 
       Else 
        lastrowTotals = WsT.Cells(WsT.Rows.Count, "A").End(xlUp).Row 
        Set WsTDateRange = WsT.Range("A2:A" & lastrowTotals) 

        With WsTDateRange 

         Set z = .Find(x, LookIn:=xlValues) 
         If Not z Is Nothing Then 
          firstAddress = z.Address 
          Do 
           z.Offset(0, 2).Value = v 
           Set z = .FindNext(z) 
           If z Is Nothing Then 
            GoTo DoneFinding 
           End If 
          Loop While z Is Nothing And z.Address <> firstAddress 
         End If 
DoneFinding: 
        End With 
       End If 
      Next x 
     End If 
    Next 

    WsT.Activate 
    Range("A2:A" & lastrowTotals).NumberFormat = "dd/mm/yyyy" 
    Range("B2:B" & lastrowTotals).NumberFormat = "General" 
    Range("C2:C" & lastrowTotals).NumberFormat = "General" 
    WsT.Range("A2:C50000").CurrentRegion.Sort WsT.Range("A2:C2"), xlAscending 

End Sub 

I geändert haben die folgenden:. - WsT.Range ("A2: C50000") CurrentRegion.Sort WsT.Range ("A2: C2"), xlAscending - Integer zu lange - entfernt die nutzlos Else - die undefinierten z, x, y und firstAddress

ändern auch die Art und Weise Sie den Fund aussehen definiert: set z = .Find (x, Lookin:= xlPart) xlPart andere Ergebnisse alsgeben kann.

Es kann funktionieren. Viel Glück!