Excel(マクロなど)に関しての質問です

とあるデータを作成したいのですが量が膨大で
手作業だとミスが発生する可能性が高いのと、期日に間に合わない為
できる限り手作業を減らしたいといった感じです。

データは以下のようになってます。（Excel2007です）

「シート１」
__A __________B_______ C
4 神奈川県 青葉区 青葉区
5 神奈川県 青葉区 青葉区
6 神奈川県 青葉区 青葉区
7 神奈川県 青葉区 青葉区
8 神奈川県 青葉区 青葉区

「シート２」
青葉区
緑区
○○区
××区
～

手作業による手順です。

「シート１」4～8行をコピー
9行目に貼り付け
「シート２」に移る
青葉区はできているので次の文字をコピー（上記では（緑区））
「シート１」に戻る
9行目以降の「青葉区」の文字を「緑区」に全て置換

10～14行目をコピー
15行目に貼り付け
「シート２」に移る
緑区の次の文字をコピー（上記では（○○区））
「シート１」に戻る
15行目以降の「緑区」の文字を「○○区」に全て置換

～以降シート２のエリア名分が終わるまで繰り返し。

以上、シート２のエリア名を入れ込んでシート１のデータを完成させたいのですが。
エリア名が1400以上あるので、確実にどこかで間違える気がします。

一部だけでも自動化なり、ミスを減らす方法、早くできる工程はないかと
思いましてこの場を借りさせていただきました。

自分なりに考えたり調べたりしたのですが、関数はまずこの場合
向いてないのでマクロかなと思ったのですが
どんどん作るデータが下にずれ込んでいく場合のマクロの使い方もよくわからず、
調べてる時間もない為、非常に困っています。

自分なりにまだ調べてはいきますが、よろしければご協力いただければと思います。

長くなりましたが、よろしくお願いいたします。

No.5 ベストアンサー 回答者： tom04 回答日時： 2011/07/21 20:32

こんばんは！

一例です。

Sheet2「区」のデータはA列の2行目からあるとします。

Alt＋F8キー　→　VBE画面が出ますので、↓のコードをコピー＆ペーストしてマクロを実行してみてください。
（Alt＋F8キー　→　マクロ　→　マクロ実行です）

Sub test() 'この行から
Dim i, j, k As Long
Dim ws1, ws2 As Worksheet
Set ws1 = Worksheets("sheet1")
Set ws2 = Worksheets("sheet2")
For i = 2 To ws2.Cells(Rows.Count, 1).End(xlUp).Row '※注
j = ws1.Cells(Rows.Count, 1).End(xlUp).Row - 4
If ws1.Cells(j, 2) <> ws2.Cells(i, 1) Then
Range(ws1.Cells(j, 1), ws1.Cells(j + 4, 3)).Copy
ws1.Cells(Rows.Count, 1).End(xlUp).Offset(1).Select
ActiveSheet.Paste
k = ws1.Cells(Rows.Count, 1).End(xlUp).Row - 4
Range(ws1.Cells(k, 2), ws1.Cells(k + 4, 3)) = ws2.Cells(i, 1)
End If
Next i
Application.CutCopyMode = False
ws1.Cells(Rows.Count, 1).End(xlUp).Offset(1).Select
End Sub 'この行まで

尚、Sheet2の「区」のデータがA列の1行目からある場合は
コード内の　※注　の行を
＞For i = 1 To ws2.Cells(Rows.Count, 1).End(xlUp).Row
に変更してみてください。

以上、参考になれば良いのですが
外していたらごめんなさいね。m(_ _)m

この回答へのお礼

ありがとうございます！おかげさまで色々間に合いました！
本当にありがとうございます！

お礼日時：2011/07/26 23:20

No.4 回答者： kagakusuki 回答日時： 2011/07/21 14:38

　今仮に、Sheet２において「青葉区」と入力されているセルが、Sheet2のA1セルであるものとします。

　まず、適当な空きシート（例えばSheet3）のA4セルに次の関数を入力して下さい。

=IF(INDEX(Sheet2!$A:$A,ROUNDUP(ROWS($4:4)/5,0))="","",IF(ISNUMBER(Sheet1!A$4),Sheet1!A$4,SUBSTITUTE(Sheet1!A$4,Sheet2!$A$1,INDEX(Sheet2!$A:$A,ROUNDUP(ROWS($4:4)/5,0)))))

　次に、以下の操作を行って下さい。

Sheet3のA4セルにカーソルを合わせてマウスを右クリック
　　↓
現れた選択肢の中にある[コピー]をクリック
　　↓
名前ボックス（A1セルの上にある、選択したセル範囲等が表示される欄）に、

A4:C7503

などという具合に、Sheet1の表を全てカバーするのに充分なだけのセル範囲を入力
※上記はエリア数が1500の場合の話で　Sheet1の表の行数は3+1500×5＝7503行が必要となります。
（カバーする範囲の方が広ければ、丁度同じだけの範囲である必要はありません）
　　↓
A4:C7503のセル範囲が選択されている状態で、選択範囲を示す黒い太枠の内側にカーソルを合わせてマウスを右クリック
　　↓
現れた選択肢の中にある[コピー]をクリック
　　↓
Sheet1のA4セルにカーソルを合わせてマウスを右クリック
　　↓
現れた選択肢の中にある[形式を選択して貼り付け]をクリック
　　↓
現れた「形式を選択して貼り付け」ダイアログボックスの「値」と記されている箇所をクリックして、チェックを入れる
　　↓
「形式を選択して貼り付け」ダイアログボックスの[OK]ボタンをクリック
　　↓
必要があれば、[形式を選択して貼り付け]機能を使用して、Sheet1の4行目の書式をコピーして、5行目以下に貼り付ける

　細かく説明しているため長くなりましたが、実際の作業はあまり面倒なものではないと思います。
　それに、Sheet3はそのまま何度でも使いまわす事が出来ますから、2回目以降の作業は、基本的にSheet1の4行目のみの入力と、[コピー]&[形式を選択して貼り付け]で値のみコピーだけとなります。

No.3 回答者： imogasi 回答日時： 2011/07/21 10:19

ここへ質問する前に、マクロの記録を採って勉強しましたか。

煩雑な作業を回答者にやってくれと丸投げしている。
マクロに記録で、１単位作業を（＝シート２の１行分）マクロの記録を取り、考えること
（１）まず３つのシートを扱う準備
Dim sh1, sh2, sh3
Set sh1 = Worksheets("Sheet1")
・・・
（２）シート１が、４－８行の固定なら何も難しい点が無い。
sh1.Range("A4:C8")
ここの中でシート２の各行の語句で置換。その後シート３に貼り付け
（３）シート２の各行分について単位作業を繰返す
シート２の最終行（＝全作業の終わり）は例えば
Sub test01()
d2 = Worksheets("Sheet2").Range("A65536").End(xlUp).Row
' d2=sh2.Range("A65536").End(xlUp).Row (1)を済ませた場合はこれ
MsgBox d2
For i = 2 To d2
'処理
Next i
End Sub
ーーー
（４）置換はマクロ操作で,どういうコードになるか分かる。
青葉区ー＞緑区
緑区ー＞○○区
のような順次置換になるだろう。
それか、A4:C8を原本部分と考えて、別セル範囲へ毎回コピーし、そこで置換（青葉区固定ーー＞XX)して、シート３にコピー貼り付けも良い。
（５）コピー貼り付けは、（Paste方式は避け他方が良いが）
Sub test03()
Set sh1 = Worksheets("Sheet1")
Set sh3 = Worksheets("Sheet3")
'Sheet1置換後（コード略）
d3 = sh3.Range("A65536").End(xlUp).Row+1
sh1.Range("A4:C8").Copy sh3.Cells(d3, "A")
End Sub
順次シート３で下方向に累積していく
各単位作業ごとに、シート３で１行とかあけるのかどうか、質問ではっきりしない。あけるならその手当てをする。ｄ３の＋１を調節する。

No.2 回答者： keithin 回答日時： 2011/07/21 03:29

シート１のB4に

=INDEX(Sheet2!$A:$A,ROW(B5)/5)&""
と記入し，C4にコピー
B4:C4をひたすら下向けにコピー。

A4に
=IF(B4="","","神奈川")
と記入し，ひたすら下向けにコピー。

No.1 回答者： mshr1962 回答日時： 2011/07/21 02:49

一例ですが

Sub LCOPY()
Dim RG As Range
X = 4
For Each RG In Worksheets("シート２").RANGE("A1:A1500")
If RG Is Null Then Exit Sub
For i = 1 to 5
Cells(X,1) = "神奈川県"
Cells(X,2) = RG
Cells(X,3) = RG
X = X + 1
Next i
Next RG
End Sub