Question

我一直在previous post寻找一种方法来创建一个宏，该宏涉及通过find函数使用循环，如下所示：

With ActiveSheet
    For i = 1 To LastEntity
    Cells.Find(What:="ENTITY(i)", After:=ActiveCell, LookIn:=xlFormulas, _
               MatchCase:=False, SearchFormat:=False).Activate
    SOME OPERATION
    Next i

这里＆＃34; ENTITY（I）＆＃34;用于模仿以下代码用于打开多个文件的过程：

    For i = 1 To .FoundFiles.Count
        Set wb = Workbooks.Open(Filename:=.FoundFiles(i))
        SOME OPERATION
    Next i

我的问题是：如何将此功能正确扩展到查找功能？我确信我上面写的方式不正确，但我也确定必须有办法。任何帮助将不胜感激！

编辑：

如果需要双循环，是否可以进行以下更改？

Sub searchRangeAndDoStuff(ByVal ENTITY As String)

Dim xlRange As Excel.Range, varA As Variant, i As Long, x As Long

x = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row

Set xlRange = ActiveSheet.Range(Cells(1, 1), Cells(x, 1))

set varA = xlRange.value

For i = LBound(varA, 1) To UBound(varA, 1)
    If InStr(1, varA(i, 1), ENTITY, vbTextCompare) Then
    Copy ENTITY
        For j = Beginning To End 
            If InStr(1, varA(j, 1), ITEM, vbTextCompare) Then
            Move cells down
            Move up one cell
            Paste ENTITY
            End If
        Next j
     End If
 Next i          

End Sub

Answer 1

此子目录采用名为ENTITY的搜索值。它获得A列中的最后一行数据，并指定A1：A＆amp; x到一个变体，它允许我非常快速有效地循环它。默认情况下，变体将具有2个维度，因此最好指定您希望循环的内容（以帮助您记住它的2维，如果没有其他的话）

     Sub searchRangeAndDoStuff(ByVal ENTITY As String)

    'allocate for an excel range, a variant and 2 longs
    Dim xlRange As Excel.Range, varA As Variant, i As Long, x As Long

    'set one of the longs to the last row of data in column a
    x = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row

    'set the range variable to this selection of cells
    Set xlRange = ActiveSheet.Range(Cells(1, 1), Cells(x, 1))
    'set the variant to the value of that range, producing a 2d variant array
    set varA = xlRange.value

   'move through the first dimension of the array (representing rows)
    For i = LBound(varA, 1) To UBound(varA, 1)
        'if you find the string value of the ENTITY variable in the cell somewhere
        If InStr(1, varA(i, 1), ENTITY, vbTextCompare) Then
            'do stuff
        End If
    Next i


    End Sub

如果您需要保留行号，并且您的范围始终不会从顶部开始，则可以使用

Dim xlCell as Excel.Range

For Each xlCell in xlRange
'if in string, or if string compared, do something
'or assign the values and their row numbers to a 2d string array (clng() the row
'numbers), so you can continue to work with arrays
Next xlCell

以下内容非常混乱，如果您有大量重复值，或者＆＃34;粘贴到＆＃34;范围与＆＃34;复制来自＆＃34;范围，你会得到很多奇怪的行为。但是你如何纠正这个问题将取决于你的实际项目（我已经就如何管理其中一些提出了一些建议）。它说明了如何在编辑中执行类似的操作：

Sub searchRangeAndDoStuff(ByVal ENTITY As String, ByRef CheckRange As Excel.Range)

Dim xlRange As Excel.Range, varA As Variant, x As Long
Dim xlCell As Excel.Range, xlCell1 As Excel.Range

x = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row

Set xlRange = ActiveSheet.Range(Cells(1, 1), Cells(x, 1))

'please remember that if the check range is the same as the target range
'you are going to get some very wierd behaviour

For Each xlCell In xlRange
    'StrComp matches the full string, InStr simply returns true if a substring is
    'contained within the string - I don't know which one you want, but StrComp sounded
    'closer
    If StrComp(xlCell.Value, ENTITY, vbTextCompare) = 0 Then
    varA = xlCell.Value
        For Each xlCell1 In CheckRange
            'if not xlcell.row = xlcell1.row then
                If StrComp(xlCell.Value, xlCell1.Value, vbTextCompare) = 0 Then
                    xlCell1.Insert xlDown
                    xlCell1.Offset(-1, 0).Value = varA
                End If
            'end if
        Next xlCell1
        'xlCell.Delete
    End If
Next xlCell


End Sub

通过使用搜索功能找到的字符串迭代

1 个答案: