Excel VBA質問箱 IV

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

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


46385 / 76732 ←次へ | 前へ→

【35319】Re:表の作り変え
回答  かみちゃん E-MAIL  - 06/2/26(日) 16:17 -

引用なし
パスワード
   こんにちは。かみちゃん です。

>皆さんにはには簡単かもしれませんが、教えてください。

私にとって、簡単ではありませんでしたが、

>   A   B   C    D      <出来上がり>
>  2月1日 100  50          1  2月1日 100
>  2月2日 200         →   2  2月1日  50
>  2月3日 300      30       1  2月2日 200
>                    1  2月3日 300
>                    3  2月3日  30

以下のような感じででました。(Excel2002 SP3 で動作確認すみ)

Sub Macro1()
 Dim vntData As Variant
 Dim rngList As Range
 Dim RowNo As Long
 Dim ColumnNo As Integer
 Dim MaxRowNo As Long
 Dim i As Integer
 Const OutColumnNo As Integer = 24 '出力開始列番号(24列=X列)
 
 Set rngList = Range("A1")
 
 MaxRowNo = Cells(65536, rngList.Column).End(xlUp).Row
 For RowNo = 1 To MaxRowNo
  ColumnNo = Cells(rngList.Offset(RowNo - 1).Row, OutColumnNo - 1).End(xlToLeft).Column
  vntData = rngList.Offset(RowNo - 1).Resize(, ColumnNo).Value
  Debug.Print UBound(vntData, 2)
  For i = 2 To UBound(vntData, 2)
   If vntData(1, i) <> "" Then
    Cells(65536, OutColumnNo).End(xlUp).Offset(1).Resize(, 3).Value = Array(i - 1, vntData(1, 1), vntData(1, i))
   End If
  Next
 Next
 MsgBox "処理を終了しました。"
End Sub

0 hits

【35317】表の作り変え」 rough4744 06/2/26(日) 15:40 質問
【35319】Re:表の作り変え かみちゃん 06/2/26(日) 16:17 回答
【35321】Re:表の作り変え rough4744 06/2/26(日) 17:27 質問
【35323】Re:表の作り変え かみちゃん 06/2/26(日) 17:36 発言
【35327】Re:表の作り変え rough4744 06/2/26(日) 18:23 お礼

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