Excel VBA質問箱 IV

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

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


2326 / 13644 ツリー ←次へ | 前へ→

【68704】集計表を分解するには からす 11/4/9(土) 10:36 質問[未読]
【68708】Re:集計表を分解するには UO3 11/4/9(土) 12:25 回答[未読]
【68713】Re:集計表を分解するには からす 11/4/9(土) 15:49 お礼[未読]
【68709】Re:集計表を分解するには UO3 11/4/9(土) 12:29 発言[未読]
【68714】Re:集計表を分解するには からす 11/4/9(土) 15:54 お礼[未読]

【68704】集計表を分解するには
質問  からす  - 11/4/9(土) 10:36 -

引用なし
パスワード
   お世話になります。

sheet1
  A    B    C
1 No  種類  数量
2  1  みかん  4
3  2  りんご  2
4  3  バナナ  3
5  4   桃   1
6  5  いちご  3
7

sheet2
  A    B   C
1 No  種類  カウントダウン
2  1  みかん  4
3  1  みかん  3
4  1  みかん  2
5  1  みかん  1
6  2  りんご  2
7  2  りんご  1
8  3  バナナ  3
9  3  バナナ  2
10  3  バナナ  1
11  4   桃   1
12  5  いちご  3
13  5  いちご  2
14  5  いちご  1

sheet1の表からsheet2に表を変換表示するようにしたいのです。
今回、種類は5種類にしましたが多数あります。
宜しくお願いいたします。

【68708】Re:集計表を分解するには
回答  UO3  - 11/4/9(土) 12:25 -

引用なし
パスワード
   ▼からす さん:

こんにちは
たえば、

Sub Sample()
  Dim v As Variant
  Dim w() As Variant
  Dim i As Long, j As Long, k As Long
  With Sheets("Sheet1")
    v = .Range("A1").CurrentRegion.Offset(1).Value
    ReDim w(1 To WorksheetFunction.Sum(.Columns("C")), 1 To 3)
  End With
  
  For i = LBound(v, 1) To UBound(v, 1)
    For j = 1 To v(i, 3)
      k = k + 1
      w(k, 1) = v(i, 1)
      w(k, 2) = v(i, 2)
      w(k, 3) = j
    Next
  Next
  
  With Sheets("Sheet2")
    .UsedRange.ClearContents
    .Range("A1:C1").Value = Array("No", "種類", "カウントダウン")
    .Range("A2").Resize(UBound(w, 1), UBound(w, 2)).Value = w
  End With
    
End Sub

【68709】Re:集計表を分解するには
発言  UO3  - 11/4/9(土) 12:29 -

引用なし
パスワード
   ▼からす さん:

ごめんなさい。
カウントダウンじゃなく、カウントアップになってました。

    For j = v(i, 3) To 1 Step -1

にしてください。

【68713】Re:集計表を分解するには
お礼  からす  - 11/4/9(土) 15:49 -

引用なし
パスワード
   UO3さん、こんにちは。

ご教授ありがとうございます。
UO3さんに教えていただいたもので早速作って試しました。
希望通りのものが出来ました。感謝、感謝です。
本当にありがとうございました。

【68714】Re:集計表を分解するには
お礼  からす  - 11/4/9(土) 15:54 -

引用なし
パスワード
   UO3さん、こんにちは。

修正して試しました。希望通りでした。
ありがとうございました。

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