# 如何使函数递归

##### 问题描述投票：0回答：2

``````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
``````
excel vba
##### 2个回答
0

``````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
``````

0

``````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