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

此外，倒数第二行： 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可以给出比不同的结果。

它可能工作。祝你好运！

VBA在打开后只能找到一次作品

相关推荐