Question

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

如果我关闭并重新打开工作簿，它可以正常工作。但是，如果我尝试在第二次，第三次或第四次运行完全相同的宏，我搜索的部分＆＃34; z＆＃34;即使搜索变量（＆＃34; x＆＃34;）被定义为正确的日期，相应的日期也存在于该范围内，范围为{＆＃34;}正确定义。

这个问题之前已被问及并回答过，当时问题在于OP没有包含一个＆＃34; LookIn＆＃34;。但是，我有。

它在Nothing行失败 - 返回set z = .Find (x, Lookin:= xlValues)。

Nothing

Answer 1

通常，您应该始终使用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可能会提供与xlWhole不同的结果。

它可能有用。祝你好运！

打开后VBA查找只能运行一次

1 个答案: