­ã´£³¡ªL

³oºØªí®æ, «Øij¥ÎVBA¸Õ¸Õ¡I

Sub TEST()
Dim R&, x&, y&, T$, xR As Range, xH As Range
[Sheet2!A:C].ClearContents
Set xH = [Sheet2!A1]
xH.Resize(1, 3) = Array("¼Ó¼h", "§Ç", "©m¦W")
R = Sheets("Sheet1").UsedRange.Rows.Count
For x = 2 To 14 Step 6
¡@¡@For y = 4 To R
¡@¡@¡@¡@Set xR = [Sheet1!A1].Cells(y, x)
¡@¡@¡@¡@If xR = 1 Then T = xR(1, 0) & ""
¡@¡@¡@¡@If xR(1, 3) = "¡­" Or xR(1, 4) = "¡­" Then
¡@¡@¡@¡@¡@Set xH = xH(2)
¡@¡@¡@¡@¡@xH.Resize(1, 3) = Array(T, xR, xR(1, 2))
¡@¡@¡@¡@End If
¡@¡@Next y
Next x
End Sub