运行时错误“1004”未找到单元格错误

Posted 2023-02-19

【中文标题】运行时错误“1004”未找到单元格错误

【英文标题】：Run time error '1004' No cells were found error

【发布时间】：2015-07-06 15:21:45

【问题描述】：

下面的代码显示了如何根据列的值过滤特定范围。每当我尝试第二种情况和第三种情况时，我都会遇到运行时错误。

您好 Jeeped，请查看以下编辑后的代码：

Private Sub cmdATSend_Click()
'**************************************************************
'Copy Data
'**************************************************************

Dim myProject As String, sCriteria As String

myProject = InputBox("On what sheet do you wish to transfer these data?", "Daily Alarms Tracker", "ONO, INFINITY, or NET Brazil?")

With Sheets("Daily Alarms Tracker")

    sCriteria = vbNullString
    Select Case myProject

        Case "INFINITY", "infinity", "Infinity", "inf", "Inf"
            sCriteria = "INFINITY"
        Case "ONO", "Ono", "ono"
            sCriteria = "ONO"
        Case "NET Brazil", "NET", "net brazil", "net", "Net Brazil", "NET BRAZIL"
            sCriteria = "NET Brazil"
    End Select

    If CBool(Len(sCriteria)) Then
        With .Range("C7:K18")
            .AutoFilter
            .AutoFilter Field:=1, Criteria1:=sCriteria
            '.Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).Select
            If CBool(Application.Subtotal(103, .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count))) Then
                .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1).Copy
            Else
                Debug.Print "nothing matches"
            End If
        End With
    End If
End With

'*******************************************************************
'Paste Data
'*******************************************************************

   Dim atwb As Workbook

   Set atwb = Workbooks.Open("https://ts.company.com/sites/folder1/folder2/01%20Project%20Documentations/Daily%20Alarms%20Tracker/Daily_Alarms_Tracker.xlsx")
   Set atwb = ActiveWorkbook

   Select Case sCriteria

        Case "INFINITY"
            Dim iRow As Long

                With Sheets("INFINITY")
                    eRow = .Cells(Rows.Count, "B:B").End(xlUp).Row + 1
                    .Cells(iRow, "A").PasteSpecial xlPasteValuesAndNumberFormats
                End With

        Case "ONO"
            Dim oRow As Long

                With Sheets("ONO")
                    eRow = .Cells(Rows.Count, "B:B").End(xlUp).Row + 1
                    .Cells(oRow, "A").PasteSpecial xlPasteValuesAndNumberFormats
                End With

        Case "NET"
            Dim nRow As Long

                With Sheets("NET")
                    eRow = .Cells(Rows.Count, "B:B").End(xlUp).Row + 1
                    .Cells(nRow, "A").PasteSpecial xlPasteValuesAndNumberFormats
                End With

    End Select

 End Sub

【参考方案1】：

我添加了一个变量来存储来自Select Case 的条件，并且仅在有过滤记录时才将值复制到剪贴板。过滤行上的.Copy 只会复制可见行。

Private Sub cmdATSend_Click()
    Dim myProject As String, sCriteria As String, sTargetWS As String
    Dim wb As Workbook, atWB As Workbook

    myProject = InputBox("On what sheet do you wish to transfer these data?", "Daily Alarms Tracker", "ONO, INFINITY, or NET Brazil?")

    'open the target wb now for direct use later
    Set wb = ActiveWorkbook
    Set atWB = Workbooks.Open("https://ts.company.com/sites/folder1/folder2/01%20Project%20Documentations/Daily%20Alarms%20Tracker/Daily_Alarms_Tracker.xlsx")

    With wb.Sheets("Daily Alarms Tracker")

        sCriteria = vbNullString: sTargetWS = vbNullString
        Select Case myProject

            Case "INFINITY", "infinity", "Infinity", "inf", "Inf"
                sCriteria = "INFINITY"
                sTargetWS = "INFINITY"
            Case "ONO", "Ono", "ono"
                sCriteria = "ONO"
                sTargetWS = "ONO"
            Case "NET Brazil", "NET", "net brazil", "net", "Net Brazil", "NET BRAZIL"
                sCriteria = "NET Brazil"
                sTargetWS = "NET"
        End Select

        If CBool(Len(sCriteria)) Then
            With .Range("C7:k18")
                .AutoFilter
                .AutoFilter Field:=1, Criteria1:=sCriteria
                'with .offset(1,0).resize(.rows.count-1, .columns.count)
                If CBool(Application.Subtotal(103, .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count))) Then
                    .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1).Copy _
                      Destination:=atWB.Sheets(sTargetWS).Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)
                Else
                    Debug.Print "nothing matches"
                End If
            End With
        End If
    End With

    'you could close the Daily_Alarms_Tracker workbook here
    'atWB.Close savechanges:=True

    Set atWB = Nothing
    Set wb = Nothing

 End Sub

我不确定你想对这些值做什么，但在这个私有子的末尾可能有行复制到剪贴板。在没有记录的情况下进行一些错误控制可能是适当的。 sCriteria 似乎包含目标工作表的名称。

【讨论】：

请问我将如何粘贴复制的单元格？

实际上，我更喜欢从单元格到单元格的直接数据传输或.Copy Destination:=... 样式传输。要粘贴，您必须转到活动工作表，这是要避免的。如果您可以编辑原始问题以包含目标工作表和单元格（或位置描述，如 A 列中的第一个空单元格），那么我将有一些工作要做。在不知道目的地的情况下，很难选择最好的方法。

嗨吉普。我已经编辑了我原来的问题。好心检查。谢谢！ :)

@xtina1231 - 粘贴操作似乎非常接近带有值和格式的标准粘贴，因此我选择了 .Copy Destination:=... 方法并使用第二个字符串 var 来设置名称的目标工作表。目标工作簿必须在使用前打开，但无论如何都必须在某个时间打开。

工作簿已打开，但复制的数据尚未粘贴到所选工作表。