VBA初心者です。難易度が高いと思います。 添付画像の様なことを実現したいのですがVBAで可能でしょうか。
VBA初心者です。難易度が高いと思います。 添付画像の様なことを実現したいのですがVBAで可能でしょうか。 sheet1 縦列の内容をsheet2 横列へ転記する。 sheet1のA列は固定でB以降の値はグループにより異なる。 sheet2へはグループ毎に転記していき1つのグループが終われば 次のグループを記載する。
Visual Basic | Excel・95閲覧
ベストアンサー
一例です。 Sheet2は空白の状態で実行して下さい。 Sub test() Dim sh As Worksheet Dim r1 As Long, r2 As Long Dim rmax As Long Dim rng As Range Dim c1 As Integer Dim c2 As Variant Dim i As Integer Application.ScreenUpdating = False Set sh = Worksheets("Sheet2") sh.Cells(1, 1).Value = "no" r2 = 1 With Worksheets("Sheet1") rmax = .Cells(Rows.Count, 1).End(xlUp).Row For r1 = 3 To rmax If .Cells(r1, 1).Value = "no" Then r2 = r2 + 1 sh.Cells(r2, 1).Value = .Cells(r1, 2).Value r1 = r1 + 1 Do Until .Cells(r1, 1).Value = "end" Or r1 > rmax Set rng = sh.Range(sh.Cells(1, 1), sh.Cells(1, sh.Cells(1, Columns.Count).End(xlToLeft).Column)) c2 = Application.Match(.Cells(r1, 1).Value, rng, 0) If IsError(c2) Then c2 = sh.Cells(1, Columns.Count).End(xlToLeft).Column + 1 sh.Cells(1, c2).Value = .Cells(r1, 1).Value End If i = -1 For c1 = 2 To .Cells(r1, Columns.Count).End(xlToLeft).Column i = i + 1 sh.Cells(r2 + i, c2).Value = .Cells(r1, c1).Value Next c1 r1 = r1 + 1 Loop r1 = r1 + 1 r2 = r2 + i End If Next r1 End With Application.ScreenUpdating = True End Sub
質問者からのお礼コメント
回答遅れてすみません。イメージ通りです。 まだ各意味が分からないので一つづつ確認していきたいと思います。 ありがとうございました。
お礼日時：3/5 21:11
