解決済みの質問
ExcelVBAで力を貸して下さい（第３弾）
VBA初心者です。
ネット検索や本を参考に...
hbsgs870さん
ExcelVBAで力を貸して下さい（第３弾）
VBA初心者です。
ネット検索や本を参考に、行いたい処理が完成しつつありますが
問題点が２つあり、解決したいんです。詳しく教えて頂けたらと思います。
宜しくお願い致します。
◆◆
「処理済み.xls」ファイルと、「提出データ.xls」ファイルがあります。
双方には月別のシートがあります。処理は月毎に行います。
双方のファイルのA列には、同じコードが並んでいます。（昇順）
「処理済み.xls」ファイルのB列より右側にデータが入っていますが
コードにより、データが入っていない行もありますが、そこは空白行のままです。
A列のコードを参照して、
「処理済み.xls」ファイルにデータがあれば、
「提出データ.xls」ファイルの指定した列にデータをコピーしています。
◆◆
ここまで辿りつく事が出来ましたが問題点が２つあります。
１．データの貼り付け先の「提出データ.xls」ファイルには罫線の設定があり、
「値のみ」、若しくは「罫線を除く全て」で貼付けをしたいんです。
（今は書式ごと貼付けてるので、罫線がなくなってしまいます。）
２．データの貼り付け先の「提出データ.xls」ファイルを開いていないと処理ができない。
貼り付け先のファイルを開かずに、処理を進める方法はありますか？
Private 処理済ws As Long
Private 提出ws As Long
Sub Export_提出()
月 = Worksheets("TOP").Range("H3")
提出月 = Worksheets("TOP").Range("I3")
処理用Fn = Worksheets("TOP").Range("C3")
提出Fn = Worksheets("TOP").Range("D3")
For 提出ws = 1 To Workbooks(提出Fn).Worksheets(提出月).Range("A65536").End(xlUp).Row
For 処理済ws = 1 To Workbooks(処理用Fn).Worksheets(月).Range("A65536").End(xlUp).Row
If Workbooks(提出Fn).Worksheets(提出月).Range("A" & 提出ws).Value = Workbooks(処理用Fn).Worksheets(月).Range("A" & 処理済ws).Value Then
Workbooks(処理用Fn).Worksheets(月).Range("D" & 処理済ws & ":D" & 処理済ws).Copy Destination:=Workbooks(提出Fn).Worksheets(提出月).Range("D" & 提出ws)
Workbooks(処理用Fn).Worksheets(月).Range("E" & 処理済ws & ":I" & 処理済ws).Copy Destination:=Workbooks(提出Fn).Worksheets(提出月).Range("G" & 提出ws)
Exit For
End If
Next 処理済ws
Next 提出ws
End Sub
-
違反報告
ベストアンサーに選ばれた回答
hiyokosan_desuさん
ご質問のコードのまま
Copy 、PasteSpecial xlValuesで値の貼付けの方法もありますが、
総当りに近いようですので、Findメソッドを使用する例を書いてみました。
（動作確認はしていません。）
Sub Export_提出2()
Dim 月 As String, 提出月 As String
Dim 処理用Fn As String, 提出Fn As String
Dim c As Range, lastRow As Long
Dim FoundCell As Range
月 = Worksheets("TOP").Range("H3").Value
提出月 = Worksheets("TOP").Range("I3").Value
処理用Fn = Worksheets("TOP").Range("C3").Value
提出Fn = Worksheets("TOP").Range("D3").Value
'最終セルを求める
lastRow = Workbooks(処理用Fn).Worksheets(月).Range("A65536").End(xlUp).Row
For Each c In Workbooks(処理用Fn).Worksheets(月).Range("A1").Resize(lastRow)
If c.Offset(, 3).Value <> "" Then '例）処理用FnのD列が空白でない場合
'Workbooks(提出Fn).Worksheets(提出月)のA列で
'Workbooks(処理用Fn).Worksheets(月)のA列の各値(c.value)を検索する
Set FoundCell = Workbooks(提出Fn).Worksheets(提出月).Columns(1) _
.Find(What:=c.Value, LookAt:=xlWhole)
If Not FoundCell Is Nothing Then 'あった場合の処理
'D列に値を設定
FoundCell.Offset(, 3).Value = c.Offset(, 3).Value
'複数列に値を設定
FoundCell.Offset(, 6).Resize(, 5).Value = c.Offset(, 4).Resize(, 5).Value
End If
End If
Next
End Sub
＞貼り付け先のファイルを開かずに、処理を進める方法はありますか
については開いていなければWorkbooks.Openで開けばよいと思います。
Dim targetWb As Workbook
Set targetWb = Workbooks.Open("C:\temp\" & Worksheets("TOP").Range("D3").Value)
↑D3に.xlsの拡張子が無ければ補完( & ".xls")が必要かも知れません。
Set FoundCell = targetWb.Worksheets(提出月).Columns(1).Find …
-
- この質問・回答は役に立ちましたか？
- はい
- いいえ
お役立ち度：
1人中 0人が役に立つと評価しています。
ベストアンサー以外の回答
- （1件中1〜1件）
annaandoさん
>値のみ、もしくは罫線を除く全てで貼付けをしたい
Workbooks(処理用Fn).Worksheets(月).Range("D" & 処理済ws & ":D" & 処理済ws).Copy Destination:=Workbooks(提出Fn).Worksheets(提出月).Range("D" & 提出ws)
のような記述を
Workbooks(提出Fn).Worksheets(提出月).Range("D" & 提出ws) = Workbooks(処理用Fn).Worksheets(月).Range("D" & 処理済ws & ":D" & 処理済ws)
の形にすればよいのではないですか。
>貼り付け先のファイルを開かずに、処理を進める方法はありますか
私は操作したことがありませんが、次のURLをご覧になってみてください。
http://support.microsoft.com/kb/278973
あなたにおすすめの解決済みの質問
-
再度教えて下さい。エクセルVBAマクロでシート内のデータを検索して別シートに切取貼付し行削除したい 前回の質問で伝授して頂きましたが私の不注意でデータを間違って削除してしまいました。 辛うじて伝授して頂いた修正前のデ...
-
エクセルＶＢＡで現在テキストに書き込み、コマンドボタンを押すとシート１のＢ２列以降の空いている セルにテキストの数字を打ち込みたいのですが何故か空いているセルに移動してくれません。 Private Sub CommandButton1_Click...
-
”納入一覧表”のb22の氏名コード~”請求書”（印刷用）シートへvlookupで抽出。b22~b100まで印刷をしますが、すでに請求額が０（ab22列~）の請求書を印刷させない方法はありますか？追記のfor i to lastlow? Sub 請求書印刷1() Dim ...
質問した人からのコメント
エクスポート先のファ
ファイルを開いて処理
annaandoさん