我有大量的数据集(近12,000行)。我不希望在A列中搜索关键字(例如:name“),然后将其对应的值从B列移至新的工作表。我可以使用此方法,但无法弄清楚如何使其递归,因此它看起来全部为12k A列中的条目。请提供帮助。
请参阅下面的脚本,但该脚本必须是递归的
Sub Test()
With Sheets("original")
If .Range("A24").Value = "Name " Then
Sheets("new").Range("A1").Value = .Range("B24").Value
End If
End With
End Sub
答案 0 :(得分:0)
您可以循环遍历单元格的范围,并使用offset获得B列中的值以放置在新工作表中。不需要递归
Sub Test()
Dim c As Range
Dim iRow As Long
iRow = 1
For Each c In Sheets("original").Range("A:A")
If c.Value = "Name " Then
Sheets("new").Cells(iRow, 1).Value = c.Offset(0, 1).Value
'move to the next row
iRow = iRow + 1
End If
Next c
End Sub
答案 1 :(得分:0)
这里是一个使用标准二维数组的示例。字典是另一个基于数组的选项。自动筛选器或高级筛选器消除了对数组和/或遍历行的迭代的需要。
请注意,这不会循环遍历“ A列中的所有行”。当B列中没有其他值可以返回时,它将停止循环。
Sub Test2()
'
'https://stackoverflow.com/questions/55928149
'
Dim i As Long, arr As Variant, bees As Variant
With Worksheets("original")
'collect source values
arr = .Range(.Cells(7, "A"), .Cells(.Rows.Count, "B").End(xlUp)).Value2
'prepare target array
ReDim bees(1 To 1, 1 To 1)
'loop through source value array and retain column B based on condition
For i = LBound(arr, 1) To UBound(arr, 1)
'case insensitive comparison
If LCase(arr(i, 1)) = LCase("Name ") Then
'assign column B value to target array
bees(1, UBound(bees, 2)) = arr(i, 2)
'make room for next matching value
ReDim Preserve bees(1 To 1, 1 To UBound(bees, 2) + 1)
End If
Next i
'trim off the last unused element of the target array
ReDim Preserve bees(1 To 1, 1 To UBound(bees, 2) - 1)
End With
'add new worksheet at end of worksheets queue
With Worksheets.Add(after:=Worksheets(Worksheets.Count))
'rename new worksheet
.Name = "bees"
'put target array in new worksheet starting at A2
.Cells(2, "A").Resize(UBound(bees, 2), UBound(bees, 1)) = _
Application.Transpose(bees)
End With
End Sub