EXCEL VBA 行のコピー

質問

お世話になります。

添付の表1のデータがあるのですが、これをボタンが押されたら自動で表2のようにしたいのです。

やりたい事・・・

表1のA3から最下行までREADして品番(A??)と品名(B??)の空白セルを埋めたいのです。(表2黄色部分)各商品は最低でもデータ行が1行あり、各商品の行数は可変です。
最大でも10行程度だと思います。

どなたかご教授いただけますでしょうか？

よろしくお願い致します。

環境 Windows XP SP3
Excel2003

回答No.1

tom04 · ベストアンサー

こんばんは！
色々やり方はあると思いますが、一例です。

Sub Sample1()
Dim i As Long
Application.ScreenUpdating = False
For i = 2 To Cells(Rows.Count, "C").End(xlUp).Row
If Cells(i, 1) = "" Then
With Cells(i, 1)
.Value = .Offset(-1)
.Offset(, 1) = .Offset(-1, 1)
End With
End If
Next i
Application.ScreenUpdating = True
End Sub

こんな感じではどうでしょうか？m(_ _)m

お礼

tom04さん、早速のご連絡ありがとうございます！
そしていつもありがとうございます！！

諸事情によりご連絡が遅くなりまして大変申訳ありませんでした。

そして、ご教授いただきました方法でまたまた完璧に出来ました！！いつも本当にありがとうございます！

今回もお助けいただきまして誠にありがとうございました。

回答No.5

keithin

全くループせずに一発でやっつけます。

sub maco1()
　on error resume next
　with range("A2:B" & range("C65536").end(xlup).row)
　　.specialcells(xlcelltypeblanks).formular1c1 = "=R[-1]C"
　　.value = .value
　end with
end sub

お礼

keithiniさん、早速のご連絡ありがとうございました！
そしていつもご連絡いただきましてありがとうございます！

当方の諸事情によりご連絡が遅くなりまして大変申訳ありませんでした。

ご教授いただきました方法で完璧に出来ました！！
す、すごい・・ですね。
一度もループせずに実現できるなんて・・・
このようなシンプルなコードで実現できるのですね。

本当に勉強になります
。
このたびは本当にありがとうございました！

回答No.4

tsubuyuki

既に＃１さん、＃３さんが模範解答を下さっているので蛇足的に。

Sub sample()
Dim MaxRow As Long, TagRow As Long, i As Long
　　　　MaxRow = Cells(Rows.Count, 3).End(xlUp).Row
　　　　TagRow = MaxRow
　　　　　　　　For i = MaxRow To 2 Step -1
　　　　　　　　　　　　If Cells(i, 1) > 0 Then
　　　　　　　　　　　　　　　　Range(Cells(i, 1), Cells(TagRow, 1)) = Cells(i, 1)
　　　　　　　　　　　　　　　　Range(Cells(i, 2), Cells(TagRow, 2)) = Cells(i, 2)
　　　　　　　　　　　　　　　　TagRow = i - 1
　　　　　　　　　　　　End If
　　　　　　　　Next
End Sub

皆さん同様、Ｃ列で最終行を判定出来ることを前提にしています。
下から攻めるやり方ですね。

とりあえず、参考までに。

お礼

tsubuyukiさん、早速のご連絡ありがとうございました！

そして当方の諸事情によりご連絡が遅くなりまして大変申訳ありませんでした。

ご教授いただきました方法で完璧に出来ました！！
詳細なコードありがとうございます。
大変勉強になりました。

このたびは本当にありがとうございました！

回答No.3

mitarashi

どこかでみかけて、Item(0)の使い方に感心したコードをアレンジしてみました。ご参考まで。
なお、C列で最下行が判別可能である事を前提にしています。
Sub test()
Dim myArea As Range, targetRange As Range
Dim i As Long

Set targetRange = Range(Range("A1"), Range("C" & Rows.Count).End(xlUp))
For i = 1 To 2
For Each myArea In targetRange.Columns(i).SpecialCells(xlCellTypeBlanks).Areas
myArea.Value = myArea.Item(0).Value
Next myArea
Next i
End Sub

お礼

mitarashiさん、早速のご連絡ありがとうございました！

そして当方の諸事情によりご連絡が遅くなりまして大変申訳ありませんでした。

ご教授いただきました方法で完璧に出来ました！！
本当に助かりました。そして勉強させていただきました。

このたびはありがとうございました！

回答No.2

Nouble

もし仮に、
空セルのある行は
例外なくどの行も
行丸々全て空セルである。

もしそうならば、
スペシャルセルズで空セルを選び出し
不可視にし、全体をコピーし
式コピーと書式コピーをすればいいのですかね？

如何ですか？
お役に立てていたならば幸いです。

お礼

Noubleさん、早速のご連絡ありがとうございました！

当方の諸事情によりご連絡が遅くなりまして大変申訳ありませんでした。

本件を実現するためにVBAのコードばかり注力してしまっておりましたが、Noubleさんのご指摘いただきました方法で実現できるかもしれません。

試してみます！
この度は誠にありがとうございました！