VBAによる検索、置換

質問

新しい台帳を作ろうとしています。
2つのシートを用いてデータベース（シート1）そのデータを日別に抽出したもの（シート2）を使い作業をしたいと思ってます。
1ブックにつき、一ヶ月分を入力するが月末には約1000件にもデータが増えてしまう。シート1には一ヶ月通して全件表示（+随時追加可能）。しかし、シート1には未入力セルがある。シート2には日付毎に抽出転記。入力内容の変更・訂正や更新は、シート2で行いたい。シート2では入力内容が判明し次第、随時入力しシート1へ反映させたい。

シート1
A B C D E
1　No.　日付　顧客　商品名　依頼先
2　1　　1/2　**商店　N-01　(　　)
3　2　　1/4　**商店　M-50　(　　)
4　3　　1/5　++販売　O-04　(　　)
5　4　　1/4　--産業　H-07　(　　)
6　5　　1/6　##商事　M-50　(　　)
7 6　　1/4　++販売　A-30　(　　)

※そこへ日付「1/4」を選択する

シート2
A B C D E
1　No.　日付　顧客　商品名　依頼先
2　2　　1/4　**商店　M-50　(　　)
3　4　　1/4　--産業　H-07　(　　)
4 6　　1/4　++販売　A-30　(　　)
5

※依頼先が決まりこれを少し編集，追加し

シート2
A B C D E
1　No.　日付　顧客　商品名　依頼先
2　2　　1/4　**商店　M-500 "○○店"
3　4　　1/4　--産業　H-07 "▲▲会社"
4 6　　1/4　++販売　A-300 "○○店"
5

終了…

シート1
A B C D E
1　No.　日付　顧客　商品名　依頼先
2　1　　1/2　**商店　N-01 　(　　)
3　2　　1/4　**商店　M-500 "○○店"
4　3　　1/5　++販売　OS-04　(　　)
5　4　　1/4　--産業　H-07 "▲▲会社"
6　5　　1/6　##商事　M-500　(　　)
7 6　　1/4　++販売　A-300 "○○店"

　"日付を操作できるマクロボタンがある"
ボタンをクリックするとシート1の内容をシート2へ再更新するようになっている。
日付を記載しているセルがあり、マクロボタン1をクリックすると日付が進み、マクロボタン2だと戻るように
なっている。

　現行VBA
Sub ReturnDate()
Dim myRow1 As Long, myRow2 As Long
myRow1 = Sheets("運行台帳").Range("C65536").End(xlUp).Row
myRow2 = Sheets("日別抽出").Range("C65536").End(xlUp).Row
Sheets("日別抽出").Range("F4").Value = Format(DateValue(Sheets("日別抽出").Range("F4").Value) _
- 1, "yyyy/mm/dd")
If myRow2 >= 6 Then
Sheets("日別抽出").Range("C6:AB" & myRow2).ClearContents
End If
Sheets("運行台帳").Range("C6：AB" & myRow1).AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("F3：F4"), CopyToRange:=Range("C6"), Unique:=False
End Sub

上記フォームを用いたうえで追加処理は次のとおりです（出来ないところ）
　(1)上記載のシート2からコピーしてシート1へ貼り付けたいときにどのようにしたらいいのか?
※(2)シート1→シート2のフィルタコピペでは抜粋するだけだが逆の時には行番号が不確定である。不確定の行を指定できる方法は?

長々と申し訳ございません。宜しくお願いします。

回答No.3

OtenkiAme

続きです。

↓日別抽出シートで更新したデータの転記
Sub ExtrShtCopyToDataSht()
　　Dim DataSht As Worksheet
　　Dim ExtrSht As Worksheet
　　Dim Target As Range
　　Set DataSht = Worksheets("運行台帳")
　　Set ExtrSht = Worksheets("日別抽出")
　　With ExtrSht.Range("A1").CurrentRegion
　　　　.Resize(.Rows.Count - 1).Offset(1).Cut _
　　　　　　Destination:=DataSht.Range("A" & _
　　　　　　　　DataSht.Rows.Count).End(xlUp).Offset(1)
　　　　.Clear
　　End With
　　Set ExtrSht = Nothing
　　With DataSht
　　　　Set Target = .Range("A1").CurrentRegion
　　　　.Range("A1").AutoFilter Field:=5, Criteria1:="更新中"
　　　　.AutoFilter.Range.Offset(1).ClearContents
　　　　.AutoFilterMode = False
　　　　Target.Sort Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlYes
　　　　.Activate
　　End With
　　Set DataSht = Nothing
End Sub

お礼

ご丁寧な回答ありがとうございました。
貼り付けてみましたが、エラーになってしまい解決に至りませんでした。これはOtenkiAmeさんに申し訳ないのですが、私の知識がないばかりに、活かすことが出来ていないところに原因がありまして．．．

また、違う形式で再度質問を投げかけてみようと思います。

どうもありがとうございました。

回答No.2

OtenkiAme

こんにちは。

サンプルデータの位置と提示されたマクロのセル位置の関係が分かないのでサンプルデータのみで考えた参考処理です。

No.だけで整合性をとるなら、フィルタをかけたデータを運行台帳シートから日別抽出シートに転記する時、依頼先に“更新中”とFlagを立てておきます。
そして、更新したデータを日別抽出シートから運行台帳シートに転記した時、“更新中”データを削除して並べ替えたら如何でしょうか？

↓運行台帳シートでフィルタをかけたデータの転記
Sub DataShtCopyToExtrSht()
　　Dim DataSht As Worksheet
　　Dim ExtrSht As Worksheet
　　Dim Target As Range
　　Set DataSht = Worksheets("運行台帳")
　　Set ExtrSht = Worksheets("日別抽出")
　　With DataSht
　　　　With .Range("A1").CurrentRegion
　　　　　　For Each Target In .Resize(, 1).Offset(, .Columns.Count - 1)
　　　　　　　　If Target.Value = "更新中" Then
　　　　　　　　　　DataSht.AutoFilterMode = False
　　　　　　　　　　DataSht.Columns("E:E").AutoFilter Field:=1, Criteria1:="更新中"
　　　　　　　　　　MsgBox Prompt:="更新中のデータがあります。", _
　　　　　　　　　　　　Buttons:=vbExclamation, Title:="転記中止"
　　　　　　　　　　Application.Goto Reference:=ExtrSht.Range("A1"), Scroll:=True
　　　　　　　　　　DataSht.AutoFilterMode = False
　　　　　　　　　　Exit Sub
　　　　　　　　End If
　　　　　　Next Target
　　　　End With
　　　　If .AutoFilterMode = True Then
　　　　　　If .AutoFilter.Range.Rows.Count > 2 Then
　　　　　　ExtrSht.Cells.Clear
　　　　　　.Range("A1").CurrentRegion.Copy _
　　　　　　　　　　Destination:=ExtrSht.Range("A1")
　　　　　　Application.Goto Reference:=ExtrSht.Range("A1"), Scroll:=True
　　　　　　Set ExtrSht = Nothing
　　　　　　With .AutoFilter.Range
　　　　　　　　.Resize(.Rows.Count - 1, 1).Offset(1, _
　　　　　　　　　　.Columns.Count - 1).Value = "更新中"
　　　　　　End With
　　　　　　End If
　　　　　　.AutoFilterMode = False
　　　　End If
　　End With
　　Set DataSht = Nothing
End Sub

続く。

回答No.1

hige_082

シート2の必要性が質問から読み取れませんでした
オートフィルタでシート1の日付を抽出すれば
シート2と同じ結果になるのでは？
データ変更後にオートフィルタを解除すれば
シート1は希望の結果を得られるのではと思いますが？

何か理由があってシート2を使用したいのであれば
簡単な方法を一つ
シート1からデータを抽出してシート2へコピーした後
シート1の抽出したデータ行を削除する

シート2のデータを変更等の入力を行う

シート2のデータをすべてシート1の最終行へコピーする
シート1のNO.項目で並べ替えを行う
この様にすれば比較的簡単なコードで処理できると思います

以上参考まで

お礼

ヒントのご提供ありがとうございます。
筋道を導いていただいたお陰で色々と模索中ではありますが
完成に向けてぼちぼちやっております。

ホントに知識が無いので、どういったコードを入力したら良いのかもよく判りませんが、試行錯誤しながら引き続きやってみます。

ありがとうございました。