前回は別ブックの複数シートから、条件にあったものを抽出・転記させるところまで
ご回答をいただきました。その節はありがとうございました。
続きでまた詰まってしまいました・・・(頂いたコードから変わっていません・・・)
###前提・実現したいこと
作成しているのはマンションの物件管理です。
今前回回答いただいたコードをベースに加工しているのですが、以下の点でつまずいています。
・更新タイミングが複数あるため、マンション名+号室で検索をして、
すでに抽出している内容だったら上書きしたい(登録していない内容だったら最下行に貼付け)
[A列…転記するためのチェックセル→契約済だったら転記する]
[D列…重複チェックのためのセル→マンション号室が同じなら上書き(したい)]
①元ブック(複数シート)でマクロ開始
②DBブックに書き込むための条件検索(以下③と④)
③まず、「契約済」かどうかチェック[A列使用]
④「契約済」の中で、すでに登録されているかチェック[D欄使用]
登録されている…同じ行に上書き(新しくコピーしたほうを貼り付け等)
登録なし…DBブックの最下行、空いている部分に書き込み
###該当のソースコード
Sub 書きかけ() Dim wbRead As Workbook Dim wbOut As Workbook Dim shtRead As Worksheet Dim shtOut As Worksheet Set wbRead = ActiveWorkbook Set wbOut = Workbooks("VBAテスト.xlsx") Set shtOut = wbOut.Worksheets("TEST") Dim rng As Range Dim lastRow As Long '現在のブック内にあるすべてのシートをループ処理 For Each shtRead In wbRead.Worksheets '対象シート内のA列先頭からA列最終データ行までをループ処理 For Each rng In shtRead.Range(shtRead.Cells(1, 1), shtRead.Cells(shtRead.Rows.Count, 1).End(xlUp)) 'A列が「契約済」なら、 If shtRead.Cells(rng.Row, 1) = "契約済" Then '読込シートから行コピー shtRead.Rows(rng.Row).Copy 'D列全体から、検索用を探して、選択する。 Dim FoundCell As Range Set FoundCell = Range("D:D").Find(What:="検索用", LookAt:=xlWhole) '【重複ない場合】空白の行に内容を転記 If FoundCell Is Nothing Then 'DBブックを選択し、一番下の行番号を取得 lastRow = shtOut.Cells(shtOut.Rows.Count, 1).End(xlUp).Row + 1 '出力シートに値で貼り付け shtOut.Rows(lastRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False '【重複ある場合】同じ検索用の内容の行に上書きする ElseIf FoundCell = Range("D:D").Find(What:="検索用", LookAt:=xlWhole) Then 'その行に貼付け shtOut.Rows(FoundCell.Row).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End If End If Next rng Next shtRead End Sub
###試したこと
・重複ある場合の貼付けに「FoundCell.Row」を設定
・Find whatの部分で特定できていないのかと思い、以下のコードを追加
(1004エラーで不可)
Dim KENSAKU as variant shtRead.Cells(rng.Row,4)=KENSAKU Dim FoundCell As Range Set FoundCell = Range("D:D").Find(What:=KENSAKU, LookAt:=xlWhole)
FindメソッドのWhat部分をちゃんと指定できればうまくいく気がするんですが、
考え方から間違っているでしょうか・・・
最終的には「契約済みだったら~」の部分が別内容で2~3回繰り返す予定です
何卒よろしくお願いいたします。
回答1件
あなたの回答
tips
プレビュー
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
2016/08/31 03:27