VBA: 运行 通过二维变体数组删除行
VBA: Run through a 2D Variant Array deleting rows
我正在将一个范围作为 2D 变体导入 VBA 并通过 `Dim matrix() 将数组声明为变体。
我现在想遍历行并删除第 2 column = "even"
或第 5 行以 "_tom"
结尾的行。下面的数据集
我的主要问题是我不知道如何删除那些行?
1, odd, 3, 27, today
2, even, 6, 21, today_tom
3, odd, 9, 28, today
4, even, 12, 30, today
5, odd, 15, 17, today_tom
6, even, 18, 17, today
7, odd, 21, 18, today
8, even, 24, 9 , today_tom
9, odd, 27, 24, today_tom
10, even, 30, 9, today
11, odd, 33, 11, today
12, even, 36, 22, today
13, odd, 39, 8 , today
14, even, 42, 1 , today
15, odd, 45, 4 , today
当前代码:
Sub test()
Dim matrix As Variant
matrix = Range("A1:E15")
Dim r As Long
For r = LBound(matrix, 1) To UBound(matrix, 1)
If matrix(r, 2).Value = "even" Then
'delete
End If
If Right(matrix(r, 2).Value, 4) = "_tom" Then
'delete
End If
Next r
End Sub
通过Application.Index()
删除数组元素
是,可以通过 Application.Index
函数的变通方法 "delete" 数组元素,该函数由多个数组参数丰富:
Sub Restructure()
' Site:
Dim matrix As Variant
matrix = Sheet1.Range("A1:E15")
'========================================================
'Maintain only array rows <> "even" or ending with "_tom"
'--------------------------------------------------------
matrix = Application.Index(matrix, getRowNo(matrix), Array(1, 2, 3, 4, 5))
''optional: write to any target range
' Sheet1.Range("G1").Resize(UBound(matrix), UBound(matrix, 2)) = matrix
End Sub
辅助函数getRowNo()
Function getRowNo(arr) As Variant()
' Note: receives last column values of array two as 1-dim 1based array
' Purp: returns 2-dim 1-based array with row numbers if conditions met
Dim i As Long, ii As Long, tmp()
ReDim tmp(1 To 1, 1 To UBound(arr)) ' provide for temporary array
For i = LBound(arr) To UBound(arr)
If arr(i, 2) = "even" Or Right(arr(i, 5), 4) = "_tom" Then
' do nothing
Else
ii = ii + 1 ' increment temp counter
tmp(1, ii) = i ' enter row number of original column data
End If
Next i
ReDim Preserve tmp(1 To 1, 1 To ii) ' correct last dimension
getRowNo = Application.Transpose(tmp) ' return 2-dim array with rownumbers to be preserved
End Function
示例结果
进一步提示
无法通过 .Value
属性 引用数组元素,只能通过索引(例如 matrix(1,1)
)
我正在将一个范围作为 2D 变体导入 VBA 并通过 `Dim matrix() 将数组声明为变体。
我现在想遍历行并删除第 2 column = "even"
或第 5 行以 "_tom"
结尾的行。下面的数据集
我的主要问题是我不知道如何删除那些行?
1, odd, 3, 27, today
2, even, 6, 21, today_tom
3, odd, 9, 28, today
4, even, 12, 30, today
5, odd, 15, 17, today_tom
6, even, 18, 17, today
7, odd, 21, 18, today
8, even, 24, 9 , today_tom
9, odd, 27, 24, today_tom
10, even, 30, 9, today
11, odd, 33, 11, today
12, even, 36, 22, today
13, odd, 39, 8 , today
14, even, 42, 1 , today
15, odd, 45, 4 , today
当前代码:
Sub test()
Dim matrix As Variant
matrix = Range("A1:E15")
Dim r As Long
For r = LBound(matrix, 1) To UBound(matrix, 1)
If matrix(r, 2).Value = "even" Then
'delete
End If
If Right(matrix(r, 2).Value, 4) = "_tom" Then
'delete
End If
Next r
End Sub
通过Application.Index()
是,可以通过 Application.Index
函数的变通方法 "delete" 数组元素,该函数由多个数组参数丰富:
Sub Restructure()
' Site:
Dim matrix As Variant
matrix = Sheet1.Range("A1:E15")
'========================================================
'Maintain only array rows <> "even" or ending with "_tom"
'--------------------------------------------------------
matrix = Application.Index(matrix, getRowNo(matrix), Array(1, 2, 3, 4, 5))
''optional: write to any target range
' Sheet1.Range("G1").Resize(UBound(matrix), UBound(matrix, 2)) = matrix
End Sub
辅助函数getRowNo()
Function getRowNo(arr) As Variant()
' Note: receives last column values of array two as 1-dim 1based array
' Purp: returns 2-dim 1-based array with row numbers if conditions met
Dim i As Long, ii As Long, tmp()
ReDim tmp(1 To 1, 1 To UBound(arr)) ' provide for temporary array
For i = LBound(arr) To UBound(arr)
If arr(i, 2) = "even" Or Right(arr(i, 5), 4) = "_tom" Then
' do nothing
Else
ii = ii + 1 ' increment temp counter
tmp(1, ii) = i ' enter row number of original column data
End If
Next i
ReDim Preserve tmp(1 To 1, 1 To ii) ' correct last dimension
getRowNo = Application.Transpose(tmp) ' return 2-dim array with rownumbers to be preserved
End Function
示例结果
无法通过 .Value
属性 引用数组元素,只能通过索引(例如 matrix(1,1)
)