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

下面的代码在尝试将行复制到新工作表时会出现错误。 excel表单有3个表单，info（数据导出），filter（string名称），results（空白表单）

该代码应该匹配来自filter工作表的子string与信息工作表上的主要string。 如果子string包含在主string中，则会将整行复制到结果工作表中。 当它试图复制时出现错误。

我可能会过度复杂，任何帮助，不胜感激。 提前致谢。

错误：运行时错误“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被声明为.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