[[20070207040844]]　『ひとつのワークシートをある条件で複数シートに分』（ごんたけ）　ページの最後に飛ぶ

『ひとつのワークシートをある条件で複数シートに分割したい』（ごんたけ）
質問させていただきます。
当方ＥＸＣＥＬ２００３を使用中、ＯＳはＸＰです。AccessからEXCELにインポートしたひとつのシートがあります。そこの１列には商品番号がありまして、その商品番号ごとにワークシートを分割したいと思っております。どなたか方法を教えてください。

 >どなたか方法を教えてください。
 方法としては、マクロになると思います。
 だが、そのためには情報がもう少し必要になってくるでしょう。
　
 >そこの１列には商品番号がありまして
 その１列は、何処の列でしょう？
 どのようなシート構成で、どのように抽出したいのか・・・などなど
　
 ただ、、、
 個人的には、シートの量産には賛成できませんので、代案をば
　
 そのシートを、オートフィルタでフィルタをかける事で、希望の商品番号のみを画面に出すことが出来ます。
 せっかくのデータベースです。
 わざわざシートを分割する必要は無いと思います。
　
 （キリキ）（〃⌒o⌒)b　もう寝ます～ｚｚｚＺ

 Excel2003なら、ピボットテーブルの「ページの表示」が使用できると思います
 ただ、集計をする為の機能ですのでご希望通りの形になるかどうかは不明です(^_^;)

 ピボットテーブルの編集「ページエリアへの配置」
http://hamachan.fun.cx/excel/piboto2.html

 (Ohagi)

ご返事が送れて申し訳ありません。
また、情報不足ですみません。以下ファイル内容です。
各セルごとにこのようなデータが入っています。

 パラメータ１	パラメータ２	結果１	特性番号

 1.226	35.13228	0.664	4003
 1.25	16.66667	0.25	4003
 2.29	28.21317	0.9	4002
 0.04	0	0	4002
 4.01	42.63233	2.98	4004
 3.177	20.17588	0.803	4004
 1.76	34.57249	0.93	4005
 3.669	20.06536	0.921	4005
 1.62	29.56522	0.68	4005

このようなシートで、行数が5000行ほどあります。
これを特性番号別に同一ファイル内でシートを分けたいのですが。
できればシート名に特性番号入れたいです。
お教えいただければ助かります。

 試してください...

 Sub test()
 Dim dic As Object, a, i As Long, ii As Integer
 Dim w(), x, y, ws As Worksheet
 Set dic = CreateObject("Scripting.Dictionary")
 a = Sheets("Sheet1").UsedRange.Value
 For i = 2 To UBound(a,1)
      If Not IsEmpty(a(i,4)) Then
           If Not dic.Exists(a(i,4)) Then
                Redim w(1 To UBound(a,2), 1 To 1)
                For ii = 1 To UBound(a,2) : w(ii,1) = a(i, ii) : Next
                dic.add a(i,4), w
           Else
                w = dic(a(i,4)
                ReDim Preserve w(1 To UBound(w,1), 1 To UBound(w,2) + 1)
                For ii = 1 To UBound(a,2)
                     w(ii,UBound(w,2)) = a(i,ii)
                Next
                dic(a(i,4)) = w
           End If
      End If
 Next
 x = dic.Keys : y = dic.items : Erase a
 For i = 0 To UBound(x)
      On Error Resume Next
      Set ws = Sheets(x(i))
      If ws Is Nothing Then Set ws = Sheets.Add.Name = x(i)
      On Error GoTo 0
      ws.Cells.Clear
      ws.Range("a1").Resize(UBound(y(i),2), UBound(y(i),1)).Value = _
      Application.Transpose(y(i))
 Next
 Set ws = Nothing
 End Sub
 (seiya)

ありがとうございます。
早速試してみたところ、空のシートは自動的に増えるのですが、データが振り分けられません。やり方が悪いのでしょうか？

 もう一度試してもらえますか？
 (seiya)

seiyaさんできました、できました！！
おかげで先に進むことができます。こちらの知識不足で混乱させてしまいました。
ありがとうございました。

コメント返信：

[ 一覧(最新更新順) ]

[[20070207040844]] 『ひとつのワークシートをある条件で複数シートに分』（ごんたけ） ページの最後に飛ぶ

[[20070207040844]]　『ひとつのワークシートをある条件で複数シートに分』（ごんたけ）　ページの最後に飛ぶ