質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.50%
マクロ

定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

Q&A

1回答

4769閲覧

同一ブック内での他シートからのデータ転記について

退会済みユーザー

退会済みユーザー

総合スコア0

マクロ

定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

0グッド

0クリップ

投稿2017/08/15 12:39

同一ブック内で、片方のシートのデータをもう一方のシートに転記していくマクロを作成していますがうまくいきません。
シート1(移動データ)
|顧客番号|氏名|カナ氏名|
|1|山田 太郎|ヤマダ タロウ|
|4|佐藤 次郎|サトウ ジロウ|

シート2(顧客一覧)
|顧客番号|氏|名|カナ氏|カナ名|
|1|山田|太郎|ヤマダ|タロウ|
|2|鈴木|花子|スズキ|ハナコ|

###前提・実現したいこと
シート1(移動データ):アクセスデータベースから更新したデータ一覧
シート2(顧客一覧):顧客リスト

シート1を更新後、シート1のデータのうち、シート2の顧客データにまだ記載されていない顧客データについてシート2に追記を行う。追加データについては、シート2の末尾に書式コピーをした後に追記していく。
というマクロを作成したいのですが以下の問題が発生しました。
シート1の顧客番号で重複データを検索し、シート2に反映させています。

###発生している問題・エラーメッセージ

1.既存データに上書きされています。
2.また、繰り返し処理がうまくいっていないようですべての未入力データが反映されません。

エラーメッセージ
Public Sub 顧客一覧更新()
Dim 顧客番号 As Long
Dim I As Long
Dim 顧客一覧 As Worksheet
Dim 移動データ As Worksheet
Dim 演習問題_顧客一覧 As Workbook
Dim 検索_cell As Range
Dim 編集対象行 As Long

I = 1

Do Until Cells(I, 1) = "" '<== 1列目(A列)が【空になるまで】ループ処理を続行します(Untilキーワードで判定)

'ループ内で繰り返し処理される内容です If Sheets("移動データ").Range("A" & I) = 顧客番号 Then Exit Do '対象の顧客番号を見つけたらループを終了する End If I = I + 1 Loop

'③対象の顧客番号が顧客一覧に登録済かどうか確認する

'描画OFF Application.ScreenUpdating = False Sheets("顧客一覧").Activate With Sheets("顧客一覧") Columns("A:A").Select Set 検索_cell = Selection.Find(What:=.Range("A:A"), After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, MatchByte:=False, SearchFormat:=False) If 検索_cell Is Nothing Then '顧客番号が未登録の時 Range("A1028576").Select Selection.End(xlDown).Select 'Ctrl+↑で最終行を検索 編集対象行 = Selection.Row + 1 If 編集対象行 > 3 Then '2行目(行番号=4)以降は最終行の書式をコピーして新規行を作成する Rows(編集対象行 - 1).Select Selection.Copy Rows(編集対象行).Select Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False End If Else 編集対象行 = 検索_cell.Row End If Range("A" & 編集対象行) = .Range("B3") '顧客番号 Range("B" & 編集対象行) = Trim(.Range("B6")) & " " & Trim(.Range("D6")) '氏名 Range("C" & 編集対象行) = Trim(.Range("B5")) & " " & Trim(.Range("D5")) 'カナ氏名

End With

'描画ON Application.ScreenUpdating = True

End Sub

###試したこと

###補足情報(言語/FW/ツール等のバージョンなど)

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

kjml

2017/08/15 15:20

質問文に掲載するコードはコードブロックにして頂けますでしょうか。検証する側もしやすくなります。コードを選択して</>ボタンでコードブロックになります。
kjml

2017/08/15 15:23

質問文に掲載されたコードで「既存データに上書き」は本当に発生していますか?「顧客番号」を取得する部分がないように思いますが。どのような結果になるのかを明記してください。
guest

回答1

0

動作しているようには見ませんね。

・最初のループでは「顧客番号」と一致するかのチェックを行っているが、「顧客番号」は変数で定義されているだけ
・顧客一覧の顧客番号を検索しようとしているみたいですが、検索文字に検索範囲を設定していて、そもそも型エラーになっている。
※これ以上は見ていませんが。

ソース提示する際は以下のようにマークダウンして下さい。
(見にくかったので一部整形)

--VBA Public Sub 顧客一覧更新() Dim 顧客番号 As Long Dim I As Long Dim 顧客一覧 As Worksheet Dim 移動データ As Worksheet Dim 演習問題_顧客一覧 As Workbook Dim 検索_cell As Range Dim 編集対象行 As Long I = 1 Do Until Cells(I, 1) = "" '<== 1列目(A列)が【空になるまで】ループ処理を続行します(Untilキーワードで判定) 'ループ内で繰り返し処理される内容です If Sheets("移動データ").Range("A" & I) = 顧客番号 Then Exit Do '対象の顧客番号を見つけたらループを終了する End If I = I + 1 Loop '③対象の顧客番号が顧客一覧に登録済かどうか確認する '描画OFF Application.ScreenUpdating = False Sheets("顧客一覧").Activate With Sheets("顧客一覧") Columns("A:A").Select Set 検索_cell = Selection.Find( _ What:=.Range("A:A"), After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, MatchByte:=False, SearchFormat:=False _ ) If 検索_cell Is Nothing Then '顧客番号が未登録の時 Range("A1028576").Select Selection.End(xlDown).Select 'Ctrl+↑で最終行を検索 編集対象行 = Selection.Row + 1 If 編集対象行 > 3 Then '2行目(行番号=4)以降は最終行の書式をコピーして新規行を作成する Rows(編集対象行 - 1).Select Selection.Copy Rows(編集対象行).Select Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False End If Else 編集対象行 = 検索_cell.Row End If Range("A" & 編集対象行) = .Range("B3") '顧客番号 Range("B" & 編集対象行) = Trim(.Range("B6")) & " " & Trim(.Range("D6")) '氏名 Range("C" & 編集対象行) = Trim(.Range("B5")) & " " & Trim(.Range("D5")) 'カナ氏名 End With '描画ON Application.ScreenUpdating = True End Sub

投稿2017/08/15 15:22

編集2017/08/15 15:25
sazi

総合スコア25138

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

まだベストアンサーが選ばれていません

会員登録して回答してみよう

アカウントをお持ちの方は

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.50%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問