exlel 繰り返し マクロ VBA

質問

エクセルのシートで
　　　A　　　　B
　１空白　　　100
　２空白　　　A
　３空白　　　B
　４空白　　　C
　５空白　　　空白
　６空白　　　空白
　７空白　　　200
　８空白　　　A
　９空白　　　B
１０空白　　　空白
１１空白　　　300
１２空白　　　A
１３空白　　　B
１４空白　　　C
１５空白　　　D
１６空白　　　空白
上記のデータを下記の様に空白行をはさんだ不特定行のB列の各行のはじめのセルの値をA列に書き込んでいくマクロをお教えください。
　　　A　　　　B
　１100　　　　100
　２100　　　　A
　３100　　　　B
　４100　　　　C
　５100　　　　D
　６空白　　　空白
　７200　　　　200
　８200　　　　A
　９200　　　　B
１０空白　　　空白
１１300　　　　300
１２300　　　　A
１３300　　　　B
１４300　　　　C
１５300　　　　D
１６空白　　　空白

お願い致します。

回答No.3

n-jun · ベストアンサー

Sub try()
Dim r As Range

For Each r In Range("B:B").SpecialCells(xlCellTypeConstants, 3).Areas
r.Offset(, -1).Value = r.Item(1).Value
Next
End Sub

空白行も詰めた方がよいのかな？

回答No.4

KURUMITO

シート1にデータがあるとして別のシートに表示させるのでしたらマクロでなくともよいのではないでしょうか？
別のシートの1行目は空の行として、Ａ2セルには次の式を入力します。
=IF(ISNUMBER(Sheet1!B1),Sheet1!B1,IF(Sheet1!B1="","",A1))
Ｂ2セルには次の式を入力します。
=IF(Sheet1!B1="","",Sheet1!B1)
最後にＡ2セルとＢ2セルを選択してから下方にオートフィルドラッグします。

回答No.2

imogasi

判りにくい質問表現だが、結果例があるので何とか判る。
文章でロジックを文章で表現できる力を磨けば良い。
この場合行単位のデータの処理の時系列的観点を追って考える。
ほとんどの場合（初歩的な課題の場合、本件もそう）上行から下へ１行ずつ、考える（For Next）で解決できる。
今処理している行より前の行のデータ状態の影響を受けるので、変数で、あとの行の処理のときのため、どう状態を受け渡すかが課題。
Flag処理的処理である。
ーー
結果シートのA列にセットすべき値を保持する変数を１つXを設ける。
ーー
最初はデータ開始行のB列をXへ
各行を全て１つづつ処理するが
B列で空白行が現れるまでは、　ｘ－B列の値　の対を別シートにセット
B列が空白があれば読み飛ばし。
ただし最初の行は空白行として書き出し。
B列で空白以外が出現したらｘにB列の値をセットして、
X-B列を別シートにセット。
以上の繰り返し。
ーーー
丸投げ質問にコードを書きたくないが
例データ A1:B20
（ただしA列は空白）
A列　　　B列
100
A
B
C

200
A
B

300
A
B
C
D

400
x
ーーーー
Sub test05()
Dim sh1, sh2
Set sh1 = Worksheets("Sheet2")
Set sh2 = Worksheets("Sheet3")
d = sh1.Range("B65536").End(xlUp).Row
MsgBox d
k = 2
x = sh1.Cells(1, "B")
sh2.Cells(k, "A") = x
sh2.Cells(k, "B") = x
k = k + 1
For i = 2 To d
If sh1.Cells(i, "B") = "" Then
If sh2.Cells(k - 1, "B") <> "" Then
x = "" '*1
sh2.Cells(k, "A") = ""
sh2.Cells(k, "B") = ""
k = k + 1
End If
Else
If x = "" Then '*2
x = sh1.Cells(i, "B")
Else
sh2.Cells(k, "A") = x
sh2.Cells(k, "B") = x
k = k + 1
End If
End If
Next i
End Sub
ーーー
結果　A1:B15
100 100
100 100
100 100
100 100

200 200
200 200

300 300
300 300
300 300
300 300

400 400

回答No.1

kybo

Sub macro()
Dim C As Range
Dim I As Integer
’B1からB列の最終行までループ
For Each C In Range("B1", Range("B" & Rows.Count).End(xlUp))
'数字なら
If IsNumeric(C.Value) Then
’数字を変数に格納
I = C.Value
End If
’空白でないなら
If C.Value <> "" Then
　’A列に変数の数字を入力
C.Offset(, -1).Value = I
End If
Next C
End Sub