使用搜索函数迭代字符串
使用搜索函数迭代字符串
提问于 2014-05-13 16:23:16
我一直在寻找一种在previous post中创建宏的方法，该宏涉及通过查找函数使用循环，该函数如下所示：
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这里的“实体(I)”意在模仿以下代码用于打开多个文件的过程：
For i = 1 To .FoundFiles.Count
Set wb = Workbooks.Open(Filename:=.FoundFiles(i))
SOME OPERATION
Next i我的问题是:如何正确地将此功能扩展到find函数？我确信，我写上面的方式是不正确的，但我也肯定有办法做到这一点。任何帮助都将不胜感激！
编辑：
如果需要双循环，是否可以进行以下更改？
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回答 1
Stack Overflow用户
回答已采纳
发布于 2014-05-13 17:03:47
该子项接受一个名为实体的搜索值。它获取A列中的最后一行数据，并将A1 :a&x分配给一个变体，这使我能够非常快速、高效地遍历它。默认情况下，变体将有两个维度，所以最好指定您希望它循环的是哪个(帮助您记住它是二维的，如果没有其他的话)。
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下面的内容非常混乱，如果您有很多重复的值，或者“粘贴到”范围与“复制自”范围相同，那么您将得到很多奇怪的行为。但是，如何纠正这一点将取决于您的实际项目(我已经评论了一些关于如何管理这些问题的建议)。它说明了如何在编辑中执行类似于您建议的操作：
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页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/23636663
复制相关文章
相似问题
腾讯云开发者
