Excel VBA質問箱 IV

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

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


18 / 13114 ツリー ←次へ | 前へ→

【79759】入力のある項目をすべて書き出したい pen 18/4/2(月) 23:39 質問[未読]

【79760】Re:入力のある項目をすべて書き出したい hatena 18/4/3(火) 9:18 回答[未読]
【79761】Re:入力のある項目をすべて書き出したい pen 18/4/3(火) 9:40 お礼[未読]

【79760】Re:入力のある項目をすべて書き出したい
回答  hatena  - 18/4/3(火) 9:18 -

引用なし
パスワード
   単純な処理なので、二重ループでシンプルに記述できると思います。

私なら、高速化も兼ねて、シート1のデータを配列に格納して、
配列にレイアウト変更して出力し、
それをシート2に書き出す、という方法をとりますね。

Public Sub Test()
  Dim S1() As Variant, S2() As Variant
  Dim i As Long, j As Long, r As Long
  
  S1 = Sheet1.Range("A6").CurrentRegion.Value '表データを配列に格納
  ReDim S2(1 To (UBound(S1) - 1) * (UBound(S1, 2) - 3), 1 To 3) '出力用配列のサイズを確保
  
  For i = 2 To UBound(S1)
    For j = 2 To UBound(S1, 2)
      If S1(i, j) <> "" Then
        r = r + 1
        S2(r, 1) = S1(i, 1)
        S2(r, 2) = S1(1, j)
        S2(r, 3) = S1(i, j)
      End If
    Next
  Next
  
  Sheet2.Range("A1").Resize(r, 3).Value = S2
End Sub

【79761】Re:入力のある項目をすべて書き出したい
お礼  pen  - 18/4/3(火) 9:40 -

引用なし
パスワード
   hatena様

ありがとうございます。
昨夜頑張ってループ作成試みていたのですが、項目をどう持って来ていいかわからず、
改めて質問に追加しようと思っていたところでした。

勉強になりました。
配列を使ったことがなかったので、
参考にさせていただき、頑張ってみようと思います。
ありがとうございました。

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