­ã´£³¡ªL

Sub TEST_A1()
Dim Arr, Brr, xD, i&, j%, R&, V
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([¤ñ!an1], [¤ñ!e63356].End(3)(2))  '½d³ò--¦V¤U¦h¨ú¤@¦æªÅ¥Õ¦C, ­Y¤ñ¹ï¤£¨ì´N§Q¥Î³o¦æ¶ñ¤JªÅ¥Õ  
For i = 4 To UBound(Arr) - 1
    xD(Arr(i, 1) & "") = i:  V = Arr(i, 33)
    If V > 0 Then Arr(i, 33) = IIf(V Mod 2, "V", "O")
    Arr(i, 36) = IIf(Arr(i, 36) > 0, "V", "")
Next
Brr = Range([·s¤ë!j1], [·s¤ë!a63356].End(3))
For i = 4 To UBound(Brr)
    R = xD(Brr(i, 1) & ""): If R = 0 Then R = UBound(Arr)
    For j = 1 To 6
        Brr(i - 3, j) = Arr(R, Array(5, 6, 12, 16, 33, 36)(j - 1))
    Next j
101: Next i
[·s¤ë!e4].Resize(UBound(Brr) - 3, 6) = Brr
End Sub

­ã´£³¡ªL

¦^´_ 5# PJChen

¥¦¬O§ì"TÄæ"--"¦aÂI²Î­p", ­Y¤£­n, §ï¤U
For j = 1 To 6
     IF j <> 4 then  Brr(i - 3, j) = Arr(R, Array(5, 6, 12, "", 33, 36)(j - 1))
Next j

­ã´£³¡ªL

¦^´_ 7# PJChen


Brr = Range([·s¤ë!K1], [·s¤ë!a63356].End(3))
For i = 4 To UBound(Brr)
    R = xD(Brr(i, 1) & ""): If R = 0 Then R = UBound(Arr)
     For j = 1 To 7
         If j <> 4 Then Brr(i - 3, j) = Arr(R, Array(5, 14, 12, "", 33, 36, 11)(j - 1))
     Next
     Brr(i - 3, 4) = ""
Next i
[·s¤ë!e4].Resize(UBound(Brr) - 3, 7) = Brr