Question

尝试将行复制到新工作表时，下面的代码会出现错误。 excel表有3张，信息（数据导出），过滤器（字符串名称），结果（空白表）

代码应该与过滤器工作表中的子字符串匹配信息工作表上的主字符串。如果子字符串包含在主字符串中，它会将整行复制到结果工作表。当它试图复制时出现错误。

我可能会使这个过程过于复杂，非常感谢任何帮助。提前致谢。

错误：运行时错误'1004'：应用程序定义或对象定义的错误

Sub RoundedRectangle1_Click()

Dim info As Range
Dim filter As Range
Dim results As Range

Set info = Worksheets("Info").Cells(4, 5)
Set filter = Worksheets("Filter").Cells(2, 1)
Set results = Worksheets("Results").Cells(1, 1)

Dim i, j, k As Integer

i = 0
j = 0
k = 0

Do While info.Offset(i, 0) <> ""

If InStr(1, LCase(info.Offset(i, 0)), LCase(filter.Offset(k, 0))) <> 0 Then
info.Offset(i, 0).EntireRow.Copy results.Cells(j, 1)
i = i + 1
j = j + 1
k = 0
Else
If filter.Offset(k, 0) = "" Then
i = i + 1
k = 0
Else
k = k + 1
End If
End If
Loop

End Sub

Answer 1

这种情况正在发生，因为你的var J被声明为0. .Cells(0, 1)是一个无效的单元格。将J的值调整为1以解决此问题。

Sub RoundedRectangle1_Click()

Dim info As Range
Dim filter As Range
Dim results As Range

Set info = Worksheets("Info").Cells(4, 5)
Set filter = Worksheets("Filter").Cells(2, 1)
Set results = Worksheets("Results").Cells(1, 1)

Dim i, j, k As Integer

i = 0
j = 1  'Error fixed here
k = 0

Do While info.Offset(i, 0) <> ""

If InStr(1, LCase(info.Offset(i, 0)), LCase(filter.Offset(k, 0))) <> 0 Then
info.Offset(i, 0).EntireRow.Copy results.Cells(j, 1)
i = i + 1
j = j + 1
k = 0
Else
If filter.Offset(k, 0) = "" Then
i = i + 1
k = 0
Else
k = k + 1
End If
End If
Loop

End Sub

Answer 2

如果你不介意粘贴到“结果”表中的行的顺序，你可能想尝试这个：

Option Explicit

Sub main()
    Dim resultWS As Worksheet
    Dim subStrings As Variant, subString As Variant

    With Worksheets("Filter")
        subStrings = Application.Transpose(.Range("A2", .Cells(.Rows.count, 1).End(xlUp)))
    End With

    Set resultWS = Worksheets("Results")

    With Worksheets("Info")
        With .Range("E3", .Cells(.Rows.count, "E").End(xlUp))
            For Each subString In subStrings
                .AutoFilter field:=1, Criteria1:=subString
                If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then Intersect(.Resize(.Rows.count - 1).Offset(1).SpecialCells(xlCellTypeVisible).EntireRow, .Parent.UsedRange).Copy resultWS.Cells(.Rows.count, 1).End(xlUp).Offset(1)
            Next
        End With
        .AutoFilterMode = False
    End With
End Sub

将行复制到另一个工作表时出错

2 个答案: