|
▼夜勤担当 さん:
説明なしですが、
参考にどうぞ。
Sub Try1()
Dim 行見出し As Range
Dim 列見出し As Range
Dim 元データ As Range
Dim 結果()
Dim data
Dim dataCount As Long
Dim i As Long, j As Long, k As Long
With Worksheets("元データ")
Set 行見出し = .Range("A3", .Range("A65536").End(xlUp)).Resize(, 2)
Set 列見出し = .Range("C1", .Range("IV1").End(xlToLeft))
Set 元データ = 行見出し.Offset(, 2).Resize(, 列見出し.Count)
dataCount = WorksheetFunction.CountA(元データ)
ReDim 結果(dataCount, 1 To 4)
結果(0, 1) = "CD"
結果(0, 2) = "NAME"
結果(0, 3) = "PD"
結果(0, 4) = "MB"
With 元データ '元データ範囲を
For i = 1 To 行見出し.Rows.Count '行方向にループ
For j = 1 To 列見出し.Count '列方向に繰り返す
data = .Item(i, j).Value '対象セルに
If Not IsEmpty(data) Then 'データがあるとき
k = k + 1 '転記用配列の行番号を更新
結果(k, 1) = 行見出し(i, 1).Value '配列にデータを
結果(k, 2) = 行見出し(i, 2).Value '書き出す
結果(k, 3) = 列見出し(1, j).Value
結果(k, 4) = data
End If
Next
Next
End With
End With
With Worksheets("結果") '結果シートに結果の配列を書き出す
.UsedRange.ClearContents
.Range("A1").Resize(k + 1, 4).Value = 結果
End With
End Sub
|
|