VBA代碼只在debug.mode中正確工作

Question

我的VBA代碼是根據特定的輸入條件，將工作簿中幾張工作表的行復制/粘貼到另一個工作表中。它使用InStr搜索在第17-50行之間的列D中以「E」開始的工作表上查找輸入條件 - 這是行之有效的。

但是，通過按鈕激活子時，它只複製/超出它找到的第一個條目並跳轉到下一個工作表。在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來引用循環中的當前工作表。