|
发表于 2021-2-2 10:52
|
显示全部楼层
本楼为最佳答案
Sub demo()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With ActiveSheet
b = 12
For i = 1 To b
d(.Cells(2, i).Value) = i
Next
arr = Sheets("data").[a1].CurrentRegion
h = UBound(arr) - 2
ReDim brr(1 To h, 1 To b)
k = 0
For i = 4 To UBound(arr)
If arr(i, 2) <> "遺屬" Then
k = k + 1
For j = 1 To UBound(arr, 2)
If d.exists(arr(2, j)) Then brr(k, d(arr(2, j))) = arr(i, j)
Next
End If
Next
clear
.[a4].Resize(h, b) = brr
End With
End Sub
Sub clear()
ActiveSheet.UsedRange.Offset(3).clear
End Sub
祝順心,南無阿彌陀佛!
|
评分
-
查看全部评分
|