VBA 未找到单元格

Question

我昨天用了这个运行很好，但今天我收到一个错误“运行-time error '1004': No cells were found.

错误发生在

Range("A6:A30").SpecialCells(xlCellTypeVisible).Find("Temp").Select

下面附上宏

Sub HrsInput()

' Disable screen updating.

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
' Dim workbooks and sheet names.

    Dim WB1, WB2 As Workbook, Year As String
    Set WB1 = ActiveWorkbook
    Year = Mid(ActiveSheet.Name, 10, 4)
      
' Copy-n-paste raw reports.

    Dim FSO As Object, SourcePath As String, DestinPath As String
    Set FSO = CreateObject("Scripting.FileSystemObject")
    SourcePath = "\ONTWSFS003\share\MIRALOMA\Brian\Raw Reports (FM)\*.xls"
    DestinPath = "\ONTWSFS003\share\MIRALOMA\Brian\"
    FSO.CopyFile SourcePath, DestinPath

' Repeat below process until encountering an error.

    Dim FileCount As Integer
    
    Filename = Dir(SourcePath)
    Do While Filename <> ""
        FileCount = FileCount + 1
        Filename = Dir()
    Loop
        
    For FileNum = 1 To FileCount
    
    ' Open raw report.
    
        Workbooks.Open Filename:= _
            "\ONTWSFS003\share\MIRALOMA\Brian\*.xls"
    
    ' Capture raw report and total hours.
    
        Set WB2 = ActiveWorkbook
        Dim TotalOT As Double, BUNum As String, ReportDate() As String, WeekNum As Integer, ColNum As Integer
        
        BUNum = Left(Range("A5"), 7)
        ReportDate = Split(Range("A7"), " ")
        WeekNum = WorksheetFunction.WeekNum(ReportDate(4))
        
        Range("A:Q").UnMerge
        
        ' If not OT then skip the file.
        
        If Not Range("A14:Z14").Find("OT1.5") Is Nothing Then
            Range("A14:Z14").Find("OT1.5").Select
            ColNum = Selection.Column
            
            Range("A15:A300").Find("total").Select
            Selection.Offset(0, ColNum - 1).Select
            TotalOT = Selection.Value
               
        ' Fill out job title if empty.
        
            Dim EmptyJobRng As Range, EmptyJobCell As Range
            Set EmptyJobRng = Range("C15:C150").SpecialCells(xlCellTypeBlanks)
            For Each EmptyJobCell In EmptyJobRng.Cells
                If EmptyJobCell.Offset(0, 2) <> "" Then
                    EmptyJobCell = EmptyJobCell.Offset(-1, 0)
                End If
            Next EmptyJobCell
        
        ' Filter by temp only.
        
            If Not Range("C15:C100").Find("*") Is Nothing Then
                With Range("C14:Y150")
                    .AutoFilter field:=3, Criteria1:="<>"
                    .AutoFilter field:=1, Criteria1:="*Temp"
                End With
            End If
                
        ' Calculate total temp OT hours.
        
            Dim TotalTempOT As Double, OT As Range
            TotalTempOT = 0
            Range("A14:Z14").Find("OT1.5").Select
            Selection.Offset(1, 0).Select
            Selection.Resize(150, 1).Select
            Set OT = Selection.SpecialCells(xlCellTypeVisible)
            For Each TempOT In OT.Cells
                TotalTempOT = TotalTempOT + TempOT
            Next TempOT
            
        ' Filter by BU and blank rows.
        
            WB1.Activate
            With Range("A5:BD30")
                .AutoFilter field:=2, Criteria1:=BUNum
                .AutoFilter field:=WeekNum + 2, Criteria1:="="
            End With
        
        ' Locate temp row and week column to paste total temp OT hours.
        
            Range("A6:A30").SpecialCells(xlCellTypeVisible).Find("Temp").Select
            Selection.Offset(0, WeekNum + 1).Select
            Selection = TotalTempOT
            
        ' Locate CEVA row and week column to paste total CEVA OT hours (total OT - total temp OT).
        
            Range("A6:A109").SpecialCells(xlCellTypeVisible).Find("CEVA").Select
            Selection.Offset(0, WeekNum + 1).Select
            Selection = TotalOT - TotalTempOT
              
        ' Clear filters.
        
            Sheets("Tracking " & Year & " (by BU)").ShowAllData
            
        End If
    
    ' Delete current raw report.
    
        WB2.Activate
        ActiveWorkbook.Saved = True
        ActiveWorkbook.ChangeFileAccess xlReadOnly
        Kill ActiveWorkbook.FullName
        WB2.Close
        WB1.Activate

    Next FileNum
    
' Update week number and weekly total OT hours.

    ' Week number
    Range("A4").Offset(0, WeekNum).Select
    Selection.Copy
    Selection.Offset(0, 1).Select
    Selection.PasteSpecial (xlPasteFormulas)
    
    ' Report date
    Range("A5").Offset(0, WeekNum + 1).Select
    Selection = "WE" & ReportDate(4)
    
    ' Weekly total OT hours
    Range("A110").Offset(0, WeekNum).Select
    Selection.Copy
    Selection.Offset(0, 1).Select
    Selection.PasteSpecial (xlPasteFormulas)
    
    ' Format Painter to new column
    Range("B:B").Select
    Selection.Offset(0, WeekNum - 1).Select
    Selection.Copy
    Selection.Offset(0, 1).Select
    Selection.PasteSpecial (xlPasteFormats)
    
    Sheets("Tracking " & Year & " (by Loc)").Select
    Range("A:A").Select
    Selection.Offset(0, WeekNum - 1).Select
    Selection.Copy
    Selection.Offset(0, 1).Select
    Selection.PasteSpecial (xlPasteFormats)

' Notification when complete.

    MsgBox "Data imported successfully.", vbOKOnly, "Complete"
    
' Enable screen updating.

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

End Sub

Answer 1

如果没有可见单元格，

SpecialCells(xlCellTypeVisible) 会引发 run-time 错误 - 一种选择是忽略该错误：

Dim f As range
'...
Set f = Nothing
On Error Resume Next  'ignore error if no visible cells
Set f = Range("A6:A30").SpecialCells(xlCellTypeVisible).Find("Temp")
On Error Goto 0       'stop ignoring errors 

If Not f Is Nothing then
    'do something with f
Else
    'No visible cells, or no visible "Temp" cell...
End If
'...

VBA 未找到单元格

VBA No Cells are found

excel

vba

excel-formula

excel-2010

vba7