VBA代码只能在debug.mode中正确工作

我的VBA代码是根据特定的input条件从工作簿中的多个工作表中复制/粘贴行到另一个工作表中。 它使用InStrsearch在第17-50行之间的列D中以“E”开始的工作表上查找input条件 – 这是行之有效的。

但是，当通过button激活子时，它只复制/超出find的第一个条目，并跳转到下一个工作表。 在debug.mode中，它查找一个工作表中的所有条目，复制/粘贴，然后跳转到下一个工作表。

我需要改变什么？

Sub request_task_list() Dim rPlacementCell As Range Dim myValue As Variant Dim i As Integer, icount As Integer myValue = InputBox("Please enter the Name (Name or Surname) of the Person whos task you are looking for", "Input", "Hansen") If myValue = "" Then Exit Sub Else Set rPlacementCell = Worksheets("Collect_tool").Range("A3") For Each Worksheet In ActiveWorkbook.Worksheets 'Only process if the sheet name starts with 'E' If Left(Worksheet.Name, 1) = "E" Then Worksheet.Select For i = 17 To 50 If InStr(1, LCase(Range("D" & i)), LCase(myValue)) <> 0 Then 'In string search for input value from msg. box 'Copy the whole row if found to placement cell icount = icount + 1 Rows(i).EntireRow.Copy rPlacementCell.PasteSpecial xlPasteValuesAndNumberFormats Range("D2").Copy rPlacementCell.PasteSpecial xlPasteValues Set rPlacementCell = rPlacementCell.Offset(1) End If Next i End If Next Worksheet Worksheets("collect_tool").Activate Range("B3").Activate End If End Sub 

Answer 1

这段代码适用于我：

 Sub request_task_list() Dim rPlacementCell As Range Dim myValue As Variant Dim i As Integer Dim wrkBk As Workbook Dim wrkSht As Worksheet Set wrkBk = ActiveWorkbook 'or 'Set wrkBk = ThisWorkbook 'or 'Set wrkBk = Workbooks.Open("C:/abc/def/hij.xlsx") myValue = InputBox("Please enter the Name (Name or Surname) of the Person whos task you are looking for", "Input", "Hansen") If myValue <> "" Then Set rPlacementCell = wrkBk.Worksheets("Collect_tool").Range("A3") 'Be specific about which workbook the sheet is in. For Each wrkSht In wrkBk.Worksheets 'Only process if the sheet name starts with 'E' If Left(wrkSht.Name, 1) = "E" Then For i = 17 To 50 'Cells(i,4) is the same as Range("D" & i) - easier to work with numbers than letters in code. If InStr(1, LCase(wrkSht.Cells(i, 4)), LCase(myValue)) > 0 Then 'Be specific about which sheet the range is on. 'In string search for input value from msg. box 'Copy the whole row if found to placement cell wrkSht.Rows(i).EntireRow.Copy rPlacementCell.PasteSpecial xlPasteValuesAndNumberFormats rPlacementCell.Value = wrkSht.Cells(2, 4).Value Set rPlacementCell = rPlacementCell.Offset(1) End If Next i End If Next wrkSht Worksheets("collect_tool").Activate Range("B3").Activate End If End Sub 

我猜你的代码在这一点上失败了： For Each Worksheet In ActiveWorkbook.Worksheets 。 Worksheet是Worksheets集合的成员，我不认为它可以这样使用。 在我的代码中注意我已经将wrkSht设置为Worksheet对象，然后使用wrkSht引用循环中的当前工作表。