• ベストアンサー

36回のソート&コピ&ぺを、1度のマクロ実行で行うには?

初心者です。WinXP、Excel 2002を使用してます。 四苦八苦しております ブックのシート数は変動しますが、例えば、 1、37シート目(集計1)に、1行目とA列が項目で、37行(37行以下)かつ100列(100列以下)のデータ表(小数点以下の桁数1以下、空白もあり)があります。それをまず「行列を入れ替え」(私が、縦方向の方がソートしやすいと思ったため)ます。 2、次に、その1行目とA列が項目の、100行(100行以下)かつ37列(37列以下)のデータ表の、データ部分を縦方向に「昇順で並べ替え」(小数点以下の桁数1以下、空白もあり)ます。 3、うち縦方向のトップ7までだけのデータを、再度、「行列を入れ替え」て、次シートの38シート目(集計2)へ貼り付けます。元の37行(8列)のデータ表に戻ります。 ちなみに、最初(元)はソートするデータが列方向のため、縦方向でソートしたほうが良いと思いまして、2回の「行列を入れ替え」を入れました。 また、「行列を入れ替え」が2回もあるので、39シート目(集計3)のシートも追加しても構いません。 以上 36回のソート&コピー&ペースト を1回のマクロ実行で行うことができればと思っております。    どうかよろしくお願い致します。

質問者が選んだベストアンサー

  • ベストアンサー
  • papayuka
  • ベストアンサー率45% (1388/3066)
回答No.4

#1です。 > 注意して、実行前に目的のシートをアクティブシートにして > おけばよいかと思っております。 確かにその通りです。 ただ、連続で実行させる場合は意図しないシートがアクティブな状態で前のマクロが終わる事が無いように注意が必要だと言うだけです。

oshietecho-dai
質問者

お礼

度々、誠にどうも有難うございます。

その他の回答 (3)

  • papayuka
  • ベストアンサー率45% (1388/3066)
回答No.3

#1です。 複数のマクロを順番どおりに実行するには実行用の Sub を作って他のマクロを Call してあげると簡単です。 また、単独で実行する事が無いなら Sub を Private Sub にしてやるとマクロ実行のダイアログに出てこなくなり、Test1の次にTest2を実行しないとダメというケースの場合に有効です。 (但し、同一モジュールに記載されていないとダメ) '------------------------------------ Sub Jikkou()   Call Test3   Call Test4 End Sub '------------------------------------ Private Sub Test3()   MsgBox "Test3だ" End Sub '------------------------------------ Private Sub Test4()   MsgBox "Test4だ" End Sub あと、「自身でちょっと編集しました」と言う事ですが、繋ぎの部分が少し気になります。   Columns("A:D").Select   Selection.Delete Shift:=xlToLeft や   Range("C:C,D:D,E:E,F:F,G:G,H:H").Select   Range("H1").Activate   Selection.Insert Shift:=xlToRight という記述はシートを指定していませんので、実行した時にアクティブだったシートに対して処理されてしまいます。 処理したいシートを明示的に指定しないと別シートのデータを削除してしまったなんて事に成りかねません。 例えば、   Worksheets("集計1").Activate   Columns("A:D").Select   Selection.Delete Shift:=xlToLeft 又は   Worksheets("集計1").Columns("A:D").Delete Shift:=xlToLeft のように事前にアクティブシートを変更してやるか、直接指定するなどの対応が必要かと思います。

oshietecho-dai
質問者

お礼

バッチリ、Callできました。 誠に、有難うございます。 一箇所だけ、ご報告だけさせて頂きます。 -------------- > Worksheets("集計1").Activate   Columns("A:D").Select   Selection.Delete Shift:=xlToLeft -------------- の部分ですが、このまま貼り付けてみましたが、 シート名が相違(例:Sheet2)してましても、エラーにならずに、編集前と同様に書き込まれますが、 私の編集方法のどの点が悪いかが、解りません。 でも 注意して、実行前に目的のシートをアクティブシートにしておけばよいかと思っております。 下記をまた、もし、可能でございましたら、一度ご査収願います(今度は、違う形体のブックでございます)。 http://oshiete1.goo.ne.jp/kotaeru.php3?q=2309773

  • zap35
  • ベストアンサー率44% (1383/3079)
回答No.2

この質問にある内容だけで、完全に要望にfitするマクロは作れないかもしれません。 手順が毎回同じなら「ツール」→「マクロ」→「新しいマクロの記録」で操作を行って手順通りのマクロを作って見たらいかがですか? そのマクロが思ったように動かなければ、再度マクロを掲載して相談する方が早いのではないでしょうか。 なお1~3を読んでも「36回のソート&コピー&ペースト」は発生しないように思うのですが、補足していただければ幸いです

oshietecho-dai
質問者

お礼

ご回答どうも有難うございます。

  • papayuka
  • ベストアンサー率45% (1388/3066)
回答No.1

http://okwave.jp/kotaeru.php3?q=2297614 こちらの次のステップでしょうけど、正直に言って何をどうしたいのか良く解りません。 行列を入れ替えて、縦方向にソートして、再度、行列を入れ替える? 並び替えにはオプションがあって、行方向、列方向を指定出来るのですが、、、 どんなデータをどんな結果にしたいのか具体的なサンプル例と記録マクロを出された方が良いかも。 一応、下記は最終シートの A2から最終行までのデータを「列単位」で「昇順」に並び替えます。 試すならテスト環境で。 Sub Test2() Dim r As Range With Worksheets(Worksheets.Count) For Each r In .Range("A2", .Range("A65536").End(xlUp))    r.Offset(0, 1).Resize(, 255).Sort key1:=r.Offset(0, 1), _     Order1:=xlAscending, Header:=xlNo, OrderCustom:=1, _     Orientation:=xlLeftToRight Next r End With End Sub

oshietecho-dai
質問者

補足

誠に有難うございます。完璧でございました。 「Test2」にて、私の望んでいる表になったと思います。 「行列の入れ替え」は、自身が作業しやすいと勝手に思ったことでございますので意味はございません。 またサンプルと言いましても、数字のデータだけでございまして、それを整理するのに四苦八苦してる状況です。 290.9 318 660.2 673 392.9 523  … 27.6 49.5 705.4 796.3 1324.3 54   …  726.8 731.7 1161.2 52.8 621.1 562.3 … 大変恐れいりますが、ご教示願います。 前回(下記)のご回答「Test」 と 今回の「Test2」 を1回の実行で行うには、どのようにつなげて編集すればよろしいのでしょうか? 各コードの後編だけ、自身でちょっと編集しました(確認済、間違いがあるかも知れませんが!)。 --------- Sub Test() Dim i As Integer On Error Resume Next For i = 1 To Worksheets.Count - 1 Worksheets(i).Range("A65536").End(xlUp).Offset(-2, 0).EntireRow.Copy _ Destination:=Worksheets(Worksheets.Count).Range("A65536").End(xlUp).Offset(1, 0) Next i Columns("A:D").Select Selection.Delete Shift:=xlToLeft End Sub --------------------- Sub Test2() Dim r As Range With Worksheets(Worksheets.Count) For Each r In .Range("A2", .Range("A65536").End(xlUp)) r.Offset(0, 1).Resize(, 255).Sort key1:=r.Offset(0, 1), _ Order1:=xlAscending, Header:=xlNo, OrderCustom:=1, _ Orientation:=xlLeftToRight Next r End With Range("C:C,D:D,E:E,F:F,G:G,H:H").Select Range("H1").Activate Selection.Insert Shift:=xlToRight End Sub ---------------------- 補足:実際は、「Test」の前段階で1度マクロ作業をしております。 当作業は、元々は同ファイルで、1つのフォルダにある同CSVファイルからの作業なんですけど、複数の作業段階があリまして、それを1度にうまくまとめて質問書きする力が私にはありませんので、それぞれ区分けしてご質問をさせて頂いたわけでございます。 できれば、前段階のコードもつなげることが可能でしたら、また、改めて、ご質問をさせて頂きます。

関連するQ&A