|
▼tomitomi さん:
叩き台です。
Option Explicit
Sub test()
Dim wsS As Worksheet
Dim wsD As Worksheet
Dim i As Long, j As Long, m As Long, n As Long
Dim flg As Boolean
Set wsS = Sheets("Sheet1")
Set wsD = Worksheets.Add
m = 1
For i = 2 To wsS.Cells(Rows.Count, 1).End(xlUp).Row Step 3
flg = False
n = 1
For j = 2 To wsS.Cells(1, 2).End(xlToRight).Column
If wsS.Cells(i, j).Borders(xlDiagonalUp).LineStyle <> xlContinuous Then
If wsS.Cells(i, j).Value = "" Then
n = n + 1
wsD.Cells(m, n).Value = j - 1
flg = True
End If
End If
Next
If flg Then
wsD.Cells(m, 1).Value = wsS.Cells(i, 1).Value
m = m + 1
End If
Next
End Sub
|
|