Excel VBA 繰り返し処理の判別方法について

質問

縦に並んでいるデータを、0で切り換えて横に並べたいのです。

【処理の説明】
A列　　B列
　0　　会員名1
　1　　テニス
　2　　ゴルフ
　3　　卓球
　0　　会員名2
　1　　水泳
　2　　ドライブ
　0　　会員名3
　1　　サッカー
　　　　：
と、並んでいるものを別のシートに

　A列　B列　　　C列　　　D列
　0　　会員名1　テニス　ゴルフ
　0　　会員名2　水泳　　ドライブ
　0　　会員名3　サッカー

としたいのです。
0の間隔が規則的な場合は、変数を使ってできたのですが
0の間隔が不規則な場合、どうしたらよいのか頭に浮かびません…

0から次の0までの行数を、どうやって取得すればいいのでしょうか?

回答No.3

myRange · ベストアンサー

Sheet１からSheet２へ転記で、
データは、１行目から始まるとして（見出し行なしということ）

'-------------------------------
Sub Test()
　Dim R As Long
　Dim R2 As Long

　For R = 1 To Cells(Rows.Count, 1).End(xlUp).Row
　　　If Cells(R, 1).Value = 0 Then
　　　　　R2 = R2 + 1
　　　　　Sheets("Sheet2").Cells(R2, 1).Value = Cells(R, 1).Value
　　　　　Sheets("Sheet2").Cells(R2, 2).Value = Cells(R, 2).Value
　　　Else
　　　　　Sheets("Sheet2").Cells(R2, Cells(R, 1).Value + 2).Value = Cells(R, 2).Value
　　　End If
　Next R
End Sub
'-------------------------------

見出し行などある場合は適宜変更のこと。
以上です。

お礼

シンプルでわかりやすいですね!
参考にさせていただきます。
ありがとうございます。

回答No.2

watabe007

こんな感じ
Dim c As Range, myR As Long, myC As Long
With Worksheets("Sheet1")
　　For Each c In .Range("A1").CurrentRegion
　　　　If c.Column = 1 And c.Value = 0 Then
　　　　　　myR = myR + 1: myC = 1
　　　　　　Worksheets("Sheet2").Cells(myR, myC).Value = 0
　　　　ElseIf c.Column > 1 Then
　　　　　　myC = myC + 1
　　　　　　Worksheets("Sheet2").Cells(myR, myC).Value = c.Value
　　　　End If
　　Next
End With

お礼

For Each　ですね。
「使ってできなかな…」と一時考えていましたが
いまいち使い方が理解しきれなかったので
やめていました。
このように書けばいいのですね。
参考にさせていただきます、ありがとうございました。

回答No.1

web2525

書き込みの行数=０
A列を上から順に読み出すループ
　読み込んだ数値が０以外であれば
　　書き込み列数+1
　　B列のデータを読み込んで書き込む
　読み込んだ数値が０であれば
　　書き込み列＝0、書き込み行数+1
データNullでループ終了

日本語で説明するとこんな感じかな?

補足

指定回数ループするのは下記のように作成しました
（実際に使っているものの抜粋なので変数の数値などわかりにくいかもしれませんが、載せておきます）

Sub 管理表読込()
Dim i As Integer
Dim j As Integer
Dim k As Integer

i = 1
j = 15
k = 2

Do
Windows("元データ.csv").Activate

If Cells(i, 1) = 0 Then

Range(Cells(i, 2), Cells(i, 15)).Copy
Windows("管理表.xls").Activate
Cells(k, j).PasteSpecial
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

Windows("元データ.csv").Activate
Range(Cells(i + 1, 2), Cells(i + 1, 15)).Copy
Windows("管理表.xls").Activate
Cells(k, j * 2 - 1).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

Windows("元データ.csv").Activate
Range(Cells(i + 2, 2), Cells(i + 2, 15)).Copy
Windows("管理表.xls").Activate
Cells(k, j * 3 - 2).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

End If

k = k + 1
i = i + 16　　　'実際は元データが14項目あるので。

Windows("元データ.csv").Activate
Loop Until Cells(i, 1) = ""

End Sub

アドバイスいただいたことは、次のような書き方でいいのでしょうか?
（コピー元の選択のみ書きます）

if cells(i,1)=0 then
cells(i,2)/copy
else
cells(i+1,2).copy
end if