Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


23928 / 76732 ←次へ | 前へ→

【58159】Re:データの並べ替えについて
発言  kanabun  - 08/10/6(月) 20:30 -

引用なし
パスワード
   ▼夜勤担当 さん:

説明なしですが、
参考にどうぞ。

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
2 hits

【58158】データの並べ替えについて 夜勤担当 08/10/6(月) 19:43 質問
【58159】Re:データの並べ替えについて kanabun 08/10/6(月) 20:30 発言
【58162】Re:データの並べ替えについて 夜勤担当 08/10/6(月) 22:10 お礼
【58161】Re:データの並べ替えについて Hirofumi 08/10/6(月) 21:10 回答
【58163】Re:データの並べ替えについて 夜勤担当 08/10/6(月) 22:14 質問
【58178】Re:データの並べ替えについて Hirofumi 08/10/7(火) 18:20 発言
【58181】Re:データの並べ替えについて Hirofumi 08/10/7(火) 18:33 回答
【58212】Re:データの並べ替えについて 夜勤担当 08/10/11(土) 21:54 質問
【58218】Re:データの並べ替えについて Hirofumi 08/10/12(日) 4:58 回答
【58228】Re:データの並べ替えについて 夜勤担当 08/10/12(日) 21:21 お礼
【58668】Re:データの並べ替えについて 夜勤担当 08/11/4(火) 14:00 質問
【58670】Re:データの並べ替えについて kanabun 08/11/4(火) 14:22 発言
【58165】Re:データの並べ替えについて kanabun 08/10/7(火) 9:36 発言
【58210】Re:データの並べ替えについて 夜勤担当 08/10/11(土) 21:46 質問

23928 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free