|
こんばんは。
データの種類が↓のように 数字-名前
というパターンなら、
>
>A列 B列
>(参加予定者) (実際の参会者)
>01-Aさん 01-Aさん
>02-Bさん 03-Cさん
>03-Cさん 03-Cさん
>04-Dさん 06-Fさん
>05-Eさん 11-Jさん(突然参加者)
>06-Fさん 11-Jさん(突然参加者)
>07-Gさん 13-Lさん(突然参加者)
標準モジュールに
'===============================================
Sub test()
Dim marray As Variant
Dim rng As Range
Dim crng As Range
Dim ans As Variant
Dim dkey As Variant
Dim dat As Variant
Dim num As Long
Dim g0 As Long
Dim g1 As Long
Dim g2 As Long
If Cells(Rows.Count, "b").End(xlUp).Row > 1 Then
With CreateObject("scripting.dictionary")
ans = Application.Transpose(Range("b2", Cells(Rows.Count, "b").End(xlUp)).Value)
For g0 = LBound(ans) To UBound(ans)
dkey = Val(Split(ans(g0), "-")(0))
If .Exists(dkey) Then
marray = .Item(dkey)
marray(1) = marray(1) + 1
.Item(dkey) = marray
Else
.Add dkey, Array(ans(g0), 1)
End If
Next
Set rng = Range("a2", Cells(Rows.Count, "a").End(xlUp))
If rng.Row > 1 Then
For Each crng In rng
dkey = Val(Split(crng.Value, "-")(0))
If Not .Exists(dkey) Then
.Add dkey, Array(crng.Value, 1)
End If
Next
End If
g0 = LBound(.Keys)
g1 = 2
Do While g0 <= UBound(.Keys)
dat = .Item(Application.Small(.Keys, g0 + 1))(0)
num = .Item(Application.Small(.Keys, g0 + 1))(1)
For g2 = 1 To num
Cells(g1, 3).Value = dat
g1 = g1 + 1
Next
g0 = g0 + 1
Loop
End With
End If
End Sub
|
|