|
Sub 分配() '雄鹰
Dim arr, brr, crr(1 To 1000, 1 To 5)
arr = Sheets("车间监舍小组分配").Range("a1").CurrentRegion
brr = Sheets("车间监舍小组分配").Range("a38").CurrentRegion
Set d = CreateObject("scripting.dictionary")
For i = 3 To UBound(arr)
For j = 2 To UBound(arr, 2) '车间
If arr(i, j) <> "" Then
n = n + 1
d(arr(i, j)) = n '姓名和行号对应
crr(n, 1) = n
crr(n, 2) = arr(i, j)
crr(n, 5) = arr(i, 1) & arr(2, j)
End If
Next j
Next i
For i = 3 To UBound(brr) '宿舍
For j = 2 To UBound(brr, 2)
If brr(i, j) <> "" Then
If d.exists(brr(i, j)) Then
x = d(brr(i, j)) '出现过在姓名在行号
crr(x, 4) = brr(i, 1) & brr(2, j)
Else
n = n + 1
crr(n, 1) = n
crr(n, 2) = brr(i, j)
crr(n, 4) = brr(i, 1) & brr(2, j)
End If
End If
Next j
Next i
Sheets("个人小组表").Range("g2").Resize(n, 5) = crr
End Sub
|
|