VBA查找仅在打开后工作一次

我有一个宏，它涉及在动态范围内搜索日期

如果我关闭并重新打开工作簿，工作正常。但是，如果我第二次、第三次或第四次尝试运行完全相同的宏，则搜索z的部分不会为z返回任何结果，即使搜索变量x被定义为正确的日期，范围中存在相应的日期，并且范围被正确定义

这个问题以前被问过并回答过，当时的问题是OP没有包含LookIn。一、 然而，我们有

它在集合z=.Find x，Lookin:=xlValues的行上失败-这将不返回任何内容

---

通常，您应该始终使用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.RangeA2:C50000.CurrentRegion.Sort WsT.RangeA2:C2，xl -整数到长 -除去无用的东西 -定义了未定义的z、x、y和firstAddress

还可以更改您查看查找的方式： 设置z=.Find x，Lookin:=xlPart xlPart可能给出与xlWhole不同的结果

---

这可能有用。祝你好运

另外，倒数第二行：WsT.RangeA2:C50000.CurrentRegion.Sort WsT.RangeA2，xlAscending没有正确排序-这应该是从第二行向下对列A到C进行排序。相反，它会过滤所有值，包括最上面一行，以便每列顶部的文本标题位于日期顺序值的下方。也许您应该将Dim z添加为范围，然后重试？它可能会成功，谁知道呢？对于倒数第二行，试试这个：WsT.RangeA2:C50000.CurrentRegion.Sort WsT.RangeA2:C2，xlAscending@Vityata使用Header:=xlYes解决了第二个问题。是否有那么多空白？加上随机缩进，代码很难理解。如果您不确定如何正确地缩进代码，请考虑使用压入工具。我的朋友可以帮你。

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