• ベストアンサー

vbaにて並べ替えしたい。

並べ替えするには? ただいまVBA学習中です。 sheet1に次のような文字列がセルに入力されているとします。 3列で30行あります。   A列 B列 C列 1行 あ  い  う 2行 え  お  か ...以下30行まで続く。 これらを sheet2に A列 あ い う え お か のようにひとつの列へ縦にするにはどのような記述になりますか? 私なりの考え方ですが セルのスタート位置はシート1のA1とします。  シート1にて  ・あ い う と順番に配列に格納  ・セルを左に2つ下に1つ移動   この動作を30回繰り返す(for next 使えばでいいですよね?)  シート2に移動してA1から下方向へ  格納された文字列を入力する。  と、考えてみたものの記述の仕方がわかりません。 力貸してください。   

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

  • ベストアンサー
  • ja7awu
  • ベストアンサー率62% (292/464)
回答No.4

> 追加の質問したいのですが・・・ こんな感じでどうですか。 実行時、どのシートがアクティブになっていても構わないコードになっていますが、 "Sheet1" アクティブが条件なら Sheets("Sheet1"). が不要でチョット簡単になります。 Sub test() Dim Rw As Long Dim Rw2 As Long Dim MaxRow As Long MaxRow = Range("E65536").End(xlUp).Row If MaxRow = 1 Then Exit Sub Sheets("Sheet2").Columns(1).ClearContents Rw2 = 1 For Rw = 2 To MaxRow   With Sheets("Sheet2")     .Range("A" & Rw2).Value = Range("E1").Value     .Range("A" & Rw2 + 1).Value = Sheets("Sheet1").Range("E" & Rw).Value     .Range("A" & Rw2 + 2).Value = Sheets("Sheet1").Range("F1").Value     .Range("A" & Rw2 + 3).Value = Sheets("Sheet1").Range("F" & Rw).Value     .Range("A" & Rw2 + 4).Value = Sheets("Sheet1").Range("G1").Value     .Range("A" & Rw2 + 5).Value = Sheets("Sheet1").Range("G" & Rw).Value     .Range("A" & Rw2 + 6).Value = vbNullString     Rw2 = Rw2 + 7   End With Next Rw End Sub

norinori555
質問者

お礼

ありがとうございました。おかげでうまくできそうです。

その他の回答 (3)

  • mohenjo
  • ベストアンサー率37% (125/335)
回答No.3

相当、邪道ですがsheet2の1行目に見出しがあるとして Sub test() Dim rngS As Range For Each rngS In ActiveSheet.UsedRange rngS.Copy Sheets(2).Range("A65536") _ .End(xlUp).Offset(1) Next rngS End Sub 上記であれば何行でも可能ですが? 勘違いならすいません。

norinori555
質問者

お礼

ありがとうございます。 なんか、だんだん難しくなってきてる印象受けてます。 でもこれがわかるとなにかと便利なんでしょうね。 (1) For Each rngS In ActiveSheet.UsedRange の部分は「アクティブシートの記入済みセルそれぞれについて」という意味と解釈しました。 rngS.Copy Sheets(2).Range("A65536").End(xlUp).Offset(1) はA列すべてって意味かな?たぶん。 で、正しく作動したのですが、なんか不思議な感じします。セルをひとつづつ指定せず、範囲という形で指定していますが、順序よく整列されてシート2に出力されました。 なんでだろ?  RANGEは 左から右 上から下 という順番で処理してくれているようですね。

norinori555
質問者

補足

追加の質問したいのですが、みなさまよいでしょうか。     E列 F列 G列 1行  問題  解答  解説 2行  あああ いいい ううう 3行  えええ おおお かかか 4行  ききき くくく けけけ ・・・このようなのが30行ぐらいあります。 今後も増えます。 とあるものを シート2のA列に 問題 あああ 解答 いいい 解説 ううう 「空白のセル」 問題 えええ 解答 おおお 解説 かかか 「空白のセル」 問題 ききき 解答 くくく 解説 けけけ 「空白のセル」 ・・・以下繰り返し。 の場合はどうなるでしょうか?

  • ja7awu
  • ベストアンサー率62% (292/464)
回答No.2

こんな感じでどうですか。 Sub test() Dim Rng As Range Dim Rw As Long For Each Rng In Sheets("Sheet1").Range("a1:c30")   Rw = Rw + 1   Sheets("Sheet2").Cells(Rw, 1).Value = Rng.Value Next Rng End Sub

norinori555
質問者

お礼

なるほど、配列を使わなくてもできますね。 ひとつづつ、シート2に文字を記入していっている わけですね。

  • coco1
  • ベストアンサー率25% (323/1260)
回答No.1

こんばんは。 あくまでも一つの例です。 Public Sub MySort() Dim MyStr(90) As String Dim cnt As Integer cnt = 1 For r = 1 To 30 For c = 1 To 3 MyStr(cnt) = Sheet1.Cells(r, c) cnt = cnt + 1 Next c Next r cnt = 0 Sheet2.Activate Range("a1").Select For r = 1 To 90 Cells(r, 1).Value = MyStr(r) Next r End Sub

norinori555
質問者

お礼

#1~#3の皆様、まずはお礼を申し上げます。 ただいま、皆様から教えていただいた内容を もとに、VBAを動かしてます。 for each とrangeの使い方についての例文が 記載されているサイトも探してます。 自分用に書き換えしているのですが ちょっとうまく動いてくれないで原因を 調べてます。 ですので配点はもう少しお待ちください。

関連するQ&A

専門家に質問してみよう