Excel VBA查找問題

Question

我是新來的excel VBA，雖然我嘗試了努力但沒有運氣。

問題陳述：

我有源（白色）行和目的地（顏色黃色）行的片材，對於每個源存在下一行對應的目的地的行。我必須查找一個應用程序名稱，該名稱在開始時會被用戶輸入，並將在第6列中搜索整個工作表（超過10000行），並且如果在源目錄行中找到目標行，還必須提取源行在sheet2中。

而且一個單元格中可能有很多應用程序名稱，所以它應該修剪該單元格中的所有其他應用程序名稱並僅保留搜索到的應用程序名稱。

下面是部分代碼我想：

Sub GetInterfaceCounts() 
    Dim RANGEBOTTOM As String 
    Dim cell 
    Dim strAction As String 
    Dim intAdd As Integer 
    Dim strName As String 

    intAdd = 0 
    RANGEBOTTOM = "G700" 
    strName = InputBox(Prompt:="Please enter the application name.", _ 
    Title:="Application Name", Default:="Application") 

    For Each cell In Range("G2:" & RANGEBOTTOM) 
     strAction = cell.Value 

     If InStr(1, strAction, strName) <> 0 Then 
      intAdd = intAdd + 1 
     End If 
    Next 

    MsgBox "Total number of " & strName & " counts are :" & CStr(intAdd) 
    GetMS4AppInventory (strName) 
End Sub 


Sub GetMS4AppInventory(strName As String) 

    Dim strAction 
    Dim intAdd As Integer 
    Dim RowIndex As Integer 
    RowIndex = 0 

    Sheets("Sheet1").Select 

    'For Each cell In Range("G2:G700") 
    With Worksheets("Sheet1").Range("G2:G700") 
     Set strAction = .Find(strName, LookIn:=xlValues) 

     'strAction = cell.Value 
     If Not strAction Is Nothing Then 
      Do 
       If InStr(1, strAction, strName) <> 0 Then 
        Rows(strAction.Row).Select 
        Selection.Copy 

        Sheets("MS4Inventory").Select 
        Rows(RowIndex + 1).Select 
        Selection.Insert Shift:=xlDown 
        Rows(RowIndex + 2).Select 
        Application.CutCopyMode = False 
        Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
        Cells(RowIndex + 3, 1).Select 
       End If 

       Set strAction = .FindNext(strAction) //gets hanged here go to infinite loop 
      Loop While Not strAction Is Nothing 
     End If 
    End With 
End Sub 

如果有人可以幫助我，這將是偉大的其他人工手動操作的庫存seggregation會吸我。

問候，

維傑

Answer 1

當您使用FindNext中，您可以選擇存儲第一個找到的單元格的地址，並進行比較。在您的示例中，strAction永遠不會是Nothing，因爲FindNext將繼續查找擁有它的第一個單元格。

我不確定你的白色和黃色的行是如何影響這個的，但這裏有一個基本的結構，用於查找單元格並複製它們的行。也許你可以根據你的需要修改它，或者說明你現有的數據是什麼樣的。

Sub GetInterfaceCounts() 

    Dim sName As String 
    Dim rFound As Range 
    Dim lCount As Long 
    Dim sFirstAdd As String 

    'Get the application name from the user 
    sName = InputBox(Prompt:="Please enter the application name.", _ 
     Title:="Application Name", Default:="Application") 

    'if the user doesn't press cancel 
    If Len(sName) > 0 Then 
     'Find the first instance of the application 
     Set rFound = Sheet1.Columns(7).Find(sName, , xlValues, xlPart, , , False) 

     'if something was found 
     If Not rFound Is Nothing Then 
      'Remember the first address where it was found 
      sFirstAdd = rFound.Address 

      Do 
       lCount = lCount + 1 
       'Copy the entirerow to the other sheet 
       rFound.EntireRow.Copy _ 
        rFound.Parent.Parent.Sheets("MS4Inventory").Cells(lCount, 1).EntireRow 
       'Find the next instance 
       Set rFound = Sheet1.Columns(7).FindNext(rFound) 

      'if we've looped around to the first found, then get out 
      Loop Until rFound.Address = sFirstAdd 
     End If 

     MsgBox "Total number of " & sName & " counts are :" & lCount 
    End If 

End Sub