VBA在打開後只能找到一次作品

我有一個宏，它涉及在動態範圍內搜索日期。VBA在打開後只能找到一次作品

如果我關閉並重新打開工作簿，它工作正常。但是，如果我嘗試第二次，第三次或第四次運行完全相同的宏，那麼即使搜索變量（「x」）被定義爲正確，但搜索「z」的部分對於「z」返回Nothing日期，範圍內存在相應的日期，範圍正在被正確定義。

此問題曾被問及回答，當時，問題在於OP未包含「LookIn」。然而，我有。

失敗set z = .Find (x, Lookin:= xlValues) - 返回Nothing。

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

來源

2017-05-30 Statsanalyst

此外，倒數第二行： WsT.Range（「A2：C50000」）。CurrentRegion.Sort WsT.Range（「A2」），xlAscending 不正確排序 - 這應該列排序，以C從第二排向下。相反，它會過濾包括頂行在內的所有值，以便每個列的頂部的文本標題位於日期排序值的下方。 – Statsanalyst

也許你應該添加'Dim z as Range'並重試？它可能會解決，誰知道？ – Vityata

對於倒數第二行，試試這個：'WsT.Range（「A2：C50000」）。CurrentRegion.Sort WsT.Range（「A2：C2」），xlAscending' – Vityata

一般情況下，你應該總是使用Option Explicit，以確保所有的變量都被正確地申報和打字錯誤不會在運行時發生錯誤。作爲第二點 - 嘗試格式化你的代碼，太多的空行和不好的縮進有點不可理解。看看下面的代碼，如果你願意，把它複製到你的問題。

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

我已經改變了以下內容： - WsT.Range（「A2：C50000」）CurrentRegion.Sort WsT.Range（「A2：C2」），xlAscending - 整數長 - 除去沒用Else - 定義的未定義z，x，y和firstAddress

變化還你看看找到出路： set z = .Find (x, Lookin:= xlPart) xlPart可以給出比不同的結果。

它可能工作。祝你好運！

來源

2017-05-30 15:29:57 Vityata

VBA在打開後只能找到一次作品

回答

相關問題