[[20100413151855]]　『縦展開を横展開に』（モリちゃん）　ページの最後に飛ぶ

『縦展開を横展開に』（モリちゃん）Excel2002,WindowsXP
教えてください。
下記の縦展開を横展開に別シートに展開したいのですが・・・・

 商品コード　得意先　金額
101　　　　　20　　　3000
101　　　　　15　　　2500
101　　　　　80　　　1000
101　　　　　40        50
202          10     40000
202          70     38000
202          30      1000
203          20      5000
203          80      4500
            ↓
商品コード　得意先　金額　得意先　金額　得意先　金額　得意先　金額
101　　　　　20　　　3000　　15　　2500　　80　　1000　　40　　　50
202　　　　　10　　 40000    70   38000    30    1000
203          20      5000    80    4500

宜しくお願いします。

[[20090903214940]]　『複数行のエクセルデータをキーブレイクするまで横』（困ったさん）

 これが参考になりそうですね。
 SortedList　なかなかスグレモノ・・・
 （ｍｏｍｏ）

momoさん有難うございます。少々難しくて、申し訳ございませんが上記の例題にて具体的にお願いできませんでしょうか？

 単にDictionaryオブジェクトにしちゃいましたが、下のようなサンプルコードで可能かと思います。

  Sub test()
  Dim tbl As Variant, i As Long, strTitle As String
  tbl = Sheets("Sheet1").Range("A1").CurrentRegion.Value
  With CreateObject("Scripting.Dictionary")
    For i = 2 To UBound(tbl)
      If .Exists(tbl(i, 1)) Then
        .Item(tbl(i, 1)) = .Item(tbl(i, 1)) & vbTab & tbl(i, 2) & vbTab & tbl(i, 3)
      Else
        .Add tbl(i, 1), tbl(i, 1)
      End If
    Next i
    tbl = Application.Transpose(.Items)
  End With
  With Worksheets.Add(After:=Sheets(Sheets.Count)).Range("A2").Resize(UBound(tbl))
    .Value = tbl
    .TextToColumns Range("A2"), xlDelimited, xlDoubleQuote, _
            False, True, False, False, False, False ', , True
    With .CurrentRegion.Offset(-1).Resize(1)
      strTitle = "商品コード"
      For i = 1 To (.Columns.Count - 1) / 2
        strTitle = strTitle & vbTab & "得意先" & vbTab & "金額"
      Next i
      .Value = Split(strTitle, vbTab)
    End With
  End With
  End Sub

 （ｍｏｍｏ）

momoさん、大変助かりました。有難うございます。

また、教えていただけないでしょうか？

上記、項目を以下に変更して実行しましたが”型の不一致”エラーになりました。

商品コード　⇒商品名（漢字）
得意先　　　⇒得意先名（同じく漢字）

 どこをどのように変更したのですか？
 （ｍｏｍｏ）

ﾃﾞｰﾀを商品ｺｰﾄﾞから商品名、得意先をｺｰﾄﾞから得意先名に変更しました。

 少し出かけていて遅くなりました。
 えっと、変更したのはシートのデータの方ですか？VBAのコードの方ですか？
 シートの方でしたら範囲さえ変わっていなければ何の影響も出ないはずです。
 VBAのコードでしたら、ちゃんと""で囲って文字列を変更してあげれば問題は出ないはずです。
 （ｍｏｍｏ）

シートのデータの方ですが。

 とりあえず、前回のコードで最初の1行目が表示されなかったミスを修正しました。
 でも、シートのデータが変更されてもVariant型とString型しか使ってないので型のエラーは
 でないように思いますが、どの行で出たかわかりますか？
 また、シートのデータの範囲はどこでしょう？

  Sub test()
  Dim tbl As Variant, i As Long, strTitle As String
  tbl = Sheets("Sheet1").Range("A1").CurrentRegion.Value
  With CreateObject("Scripting.Dictionary")
    For i = 2 To UBound(tbl)
      If .Exists(tbl(i, 1)) Then
        .Item(tbl(i, 1)) = .Item(tbl(i, 1)) & vbTab & tbl(i, 2) & vbTab & tbl(i, 3)
      Else
        .Add tbl(i, 1), tbl(i, 1) & vbTab & tbl(i, 2) & vbTab & tbl(i, 3)
      End If
    Next i
    tbl = Application.Transpose(.Items)
  End With
  With Worksheets.Add(After:=Sheets(Sheets.Count)).Range("A2").Resize(UBound(tbl))
    .Value = tbl
    .TextToColumns Range("A2"), xlDelimited, xlDoubleQuote, _
            False, True, False, False, False, False ', , True
    With .CurrentRegion.Offset(-1).Resize(1)
      strTitle = "商品コード"
      For i = 1 To (.Columns.Count - 1) / 2
        strTitle = strTitle & vbTab & "得意先" & vbTab & "金額"
      Next i
      .Value = Split(strTitle, vbTab)
    End With
  End With
  End Sub

 （ｍｏｍｏ）

約9000件のﾃﾞｰﾀを20件に減らしたところ、うまく動作しました。
おかしなﾃﾞｰﾀが存在していたのでしょうか？
上記で質問されました、シートのデータ範囲はどこか？とはどういう事でしょうか？

 >シートのデータ範囲はどこか？とはどういう事でしょうか？
 今現在は
 tbl = Sheets("Sheet1").Range("A1").CurrentRegion.Value
 のように、手作業だとSheet1のA1を選択してCtrl+Shiftを押しながら↓→とした時の範囲
 のデータを取得しています。
 その範囲にデータが入っていることが条件です。

 あと、たぶんこれが原因じゃないかと思うのですが
 XL2002ですと1行に入る列数は256列までですので、商品名を抜いて255列までが最大データです。
 1件につき2列使うのでINT(255/2)で127件までしか入りません。

 １つの商品名に対して127行以上の元データがありませんか？
 その場合、仕様をどうするか考えないとエラーがなおらないですね。
 （ｍｏｍｏ）

遅くなりました。127件以上あります。
仕様ベースから練り直します。
momoさん、躓いたら、また宜しくお願い致します。

コメント返信：

[ 一覧(最新更新順) ]

[[20100413151855]] 『縦展開を横展開に』（モリちゃん） ページの最後に飛ぶ

[[20100413151855]]　『縦展開を横展開に』（モリちゃん）　ページの最後に飛ぶ