Excel VBA查找问题

我是一个新手，擅长VBA，虽然我努力了，但运气不佳

问题陈述：

我有一个带有源（白色）行和目标（黄色）行的工作表，对于每个源，下一行有一个对应的目标行。我必须寻找一个应用程序名称，用户在开始时输入该名称，并将在第6列的整个工作表（超过10000行）中进行搜索，如果在目标行中找到，则必须提取源行；如果在工作表2中的源行中找到，则必须提取目标行

而且一个单元格中可能有许多应用程序名称，因此它应该从该单元格中删除所有其他应用程序名称，并只保留搜索到的应用程序名称

以下是我尝试的部分代码：

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

子GetInterfaceCounts（）
像绳子一样暗
暗室
像弦一样变暗
Dim intAdd为整数
将strName设置为字符串
intAdd=0
RANGEBOTTOM=“G700”
strName=InputBox（提示：=“请输入应用程序名称”_
标题：=“应用程序名称”，默认值：=“应用程序”）
对于范围内的每个单元格（“G2:”&RangeBooth）
strAction=单元格值
如果指令（1，指令，指令名）为0，则
intAdd=intAdd+1
如果结束
下一个
MsgBox“总计数”&strName&“计数为：”&CStr（intAdd）
GetMS4AppInventory（strName）
端接头
子GetMS4AppInventory（strName作为字符串）
模糊变形
Dim intAdd为整数
将行索引设置为整数
行索引=0
图纸（“图纸1”）。选择
'对于范围内的每个单元格（“G2:G700”）
带有工作表（“表1”）。范围（“G2:G700”）
Set strAction=.Find（strName，LookIn:=xlValues）
'strAction=cell.Value
如果不是，那就什么都不是了
做
如果指令（1，指令，指令名）为0，则
行（strAction.Row）。选择
选择，复制
工作表（“MS4Inventory”）。选择
行（行索引+1）。选择
选择。插入移位：=xlDown
行（行索引+2）。选择
Application.CutCopyMode=False
选择。插入Shift:=xlDown，CopyOrigin:=xlFormatFromLeftOrAbove
单元格（行索引+3，1）。选择
如果结束
Set strAction=.FindNext（strAction）//在此处挂起转到无限循环
环而不环则不算什么
如果结束
以
端接头

如果有人能帮我，那就太好了，否则手工做存货分类会让我吃力的

问候,

---

Vijay

使用FindNext时，必须存储第一个找到的单元格地址并进行比较。在您的示例中，strAction永远不会是空的，因为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

---

输入表的结构是什么？

Range.Offset

和

Range.Resize

是您的朋友，而不是使用

G2:G700

引用多个单元格。将值放入具有

范围的变量数组中。值

，然后逐个搜索数组而不是单元格。嗨，迪克，我真的很想感谢你，它成功了，但相信我，我的问题不同，这是一个我的努力受阻的地方。首先，我想知道为什么行rFound.EntireRow.Copy rFound.Parent.Parent.Sheets（“MS4Inventory”）.Cells（lCount，1）。当我将它们放在一行中时，EntireRow不工作会导致对象错误。如何根据计算得到列，如果在偶数行中找到，则需要位于奇数位置的下一行，就像在第2行中找到一样，我需要第3行或第5行中找到，我也需要在下一页中找到第4行，这实际上是源和目标对。