Q&A
早速の回答ありがとうございます。
「イミディエイトウィンドウ」の存在および確認方法初めて知りました。
自分の記述を改めて確認したいと思います。
Excel VBA 初心者であまり基礎も理解しておらず申し訳ありませんが、
仕事で急ぎ管理表を作成しなければならなくなりました。
わからないなりにネットで検索しながら作成したのですがつまずきまくっております。
どうぞご教示ください。(>人<;)
前提・実現したいこと
まず、実現したいことは、
複数の人がそれぞれのファイルに情報を入力します。
その情報を共有サーバー内にある集約用の管理表にそれぞれのタイミングで転記（追記）し、
最新の情報を共有したいと思っております。
これまでは集約管理表に都度ハンドで転記していたのですが、人数が大幅に増え、ファイルを開いた状態で
離席されたりと問題が出てきたのでマクロで集約できないかと下記の通り考えてみました。
＜A：入力用（転記元）＞
↓ ↓ ↓ 転記する
＜B：【共有】集約管理（転記先）＞
■マクロの手順
0. 入力用Aからの転記実行
0. 管理表Bを開いていなければ開き、読み取りで開いていたら元ファイルを開く。（基本、読み取りで開いている）
※ここで他の人が元ファイルを開いていたら「他の人が作業中です。しばらく経ってから転記し直してください。」と
メッセージを出したい。
0. 入力用AのB列「」の一つ下の行、C列からM列までをコピーし、管理表BのB列最終行の一つ下の行へ転記する。
0. 入力用Aの転記した行のB列のセルに「」を表記させる。
0. 転記後管理表Bを上書き保存し、閉じて読み取り専用で開く。
発生している問題・エラーメッセージ
①Bの集約管理ファイルを閉じていると開くのですが、開いていたらメッセージボックスは表示されず
「ファイルが見つかりません。ファイル名保存場所が正しいか・・」と出ます。
②Bの集約管理ファイルを閉じた状態にしてマクロを動かすとAの入力用をコピーせず、Bのファイルのセルを
コピーしにいきます。。
下図参照
この先から進めなくなりました。
①および②が解消できればまた進めることができると思うのですが・・
基礎を理解できていないがゆえだと思いますが、助けていただきたいです。。＞＜
よろしくお願いします。
該当のソースコード
※上記の画像と同じです
Sub 転記()
Dim wB As Workbook, wS As Worksheet
Dim myPath As String, fN As String
Dim LastRow As Long
'①A入力用（転記元）の"D1"を参照し、B共有フォルダの「管理状況」にある
'集約管理（転記先）のブックを開く
Application.DisplayAlerts = False
myPath = "共有サーバー\管理状況"
fN = "【共有】集約管理" & Range("D1").Value & "月" & ".xlsx"
Workbooks.Open Filename:=myPath & fN, Notify:=False
If ActiveWorkbook.ReadOnly Then
MsgBox "他の人が作業中です。しばらく経ってから転記し直してください。"
ActiveWorkbook.Close
Else
Sheets("list").Activate
Range("A1") = Now
End If
Application.DisplayAlerts = True
'②A入力用（転記元）のB列「」の一つ下のC列からM列までをコピー
With ThisWorkbook.Worksheets("入力フォーム")
x = 4
Do While Cells(x, 3).Value <> ""
If Cells(x, 2).Value <> "" Then
Cells(x, 2).Value = "" '----コピーと同時にB列へ転記すみ「」を追記
Range(Cells(x, 3), Cells(x, 13)).Copy
'③共有フォルダの「管理状況」にある集約管理へ転記
Set wB = Workbooks(fN)
Set wS = wB.Worksheets("list")
LastRow = wS.Cells(Rows.Count, 2).End(xlUp).Row '----B列の最終ひとつ下へ値貼り付け wS.Range("B" & LastRow).Offset(1, 0).Select ActiveSheet.PasteSpecial Paste:=xlPasteValues, _ Operation:=xlNone, SkipBlanks:=False, Transpose:=False End If x = x + 1 Loop
End With
Application.CutCopyMode = False
wB.Save
wB.Close '----元のファイルを保存し閉じる
MsgBox "転記しました。"
Workbooks.Open Filename:=myPath & fN, ReadOnly:=True '----読み取り専用で開く
End Sub
試したこと
補足情報
使用バージョン：Excel2010
回答2件
0
ベストアンサー
①Bの集約管理ファイルを閉じていると開くのですが、開いていたらメッセージボックスは表示されず「ファイルが見つかりません。ファイル名保存場所が正しいか・・」と出ます。
とりあえず既に開いている場合に閉じる処理が無いのが問題ですね。
②ActiveSheet.PasteSpecialから進めなくなりました。
このエラーの原因は本来Range.PasteSpecialにしか存在しないパラメータ「Paste:=」をWorksheet.PasteSpecialに対して使用しているためですね。
どちらも同じ名称のメソッドですから、編集の過程で変えてしまったのでしょう。
本件はコピー＆ペーストが必要ない事例ですが、そこが質問のキモなのでそのまま残しています。
しかし、色々とバグの原因が混ざっているので順番に指摘していきます。
1.DisplayAlertsの位置が良くない。
この手のスイッチは必要最小限な範囲に使うように心がけたほうが良いです。
例えば今回の場合はOpen時の様々な警告を無視するためだと思いますのでOpenだけに適用しています。
2.Withの使い方がおかしい。
WithステートメントはWorkbook、Worksheet、Rangeなどの変数の代替するためのものです。
利用するにはドットから初めなければなりませんが、提示されたコードではドットが付いていません。
3.極力ActiveSheetや省略Cellsは使わないように。
Withが上手く使えていないのが原因で、「Cells(x, 2).Value = "*"」などはActiveSheetが省略されたものとして動作します。
※プログラムを標準モジュールに書いた場合
従って、前に記載されている「Sheets("list").Activate」の影響でlistに対して処理することになり、意図したように動作しないはずです。
基本的にシートオブジェクトは指定するようにしてください。
たとえば、せっかく「Set wS = wB.Worksheets("list")」としているのに、すぐ下でActiveSheet.PasteSpecialとしていますよね。
同じオブジェクトを指すのですからwSを使いましょう。
今回の場合、Open直後に「Sheets("list").Activate」を実行しているので、この時点で変数に代入しておけばOKです。
4.インデントに手を抜かないこと。
コードが読みづらくなるということは、ミスを発見しずらくなります。
面倒でもインデント（TAB）はきれいに整えましょう。
5.処理中にRange.Selectは使わないこと。
下記のコードを見て分かるように、正しく書けばSelectは必要ありません。
もしアクティブブック・シートが切り替わった状態でSelectするとエラーの原因となりますので、どうしても使うときはブックやシートもActiveにしましょう。
マクロの最後に、マクロ実行後に選択していてほしい箇所をSelectするような目的で使うのが正しい使い方です。
とはいえ、デバッグのときは処理工程でSelectしてくれたほうが、わかりやすくて便利なので一応コメントで残しています。
できるだけ構造を変えないように修正したものがこちらです。
一応ローカル環境でデバッグしたので動くと思いますが、ご自分でも良くデバッグしてください。
VBA
1Sub 転記() 2 Dim wB As Workbook, wS As Worksheet 3 Dim myPath As String, fN As String 4 Dim x As Long 5 6 '①A入力用（転記元）の"D1"を参照し、B共有フォルダの「管理状況」にある 7 '集約管理（転記先）のブックを開く 8 myPath = "共有サーバー\管理状況\" 9 fN = "【共有】集約管理" & Range("D1").Value & "月" & ".xlsx" 10 'ローカルテスト用 11 'myPath = "C:\tmp\" 12 'fN = "管理用B.xlsx" 13 14 '既にfNを開いていたら閉じる 15 On Error Resume Next 16 Set wB = Workbooks(fN) 17 On Error GoTo 0 18 If Not wB Is Nothing Then 19 wB.Close False 20 End If 21 22 Application.DisplayAlerts = False 23 Set wB = Workbooks.Open(Filename:=myPath & fN, Notify:=False) 24 Application.DisplayAlerts = True 25 26 If wB.ReadOnly Then 27 MsgBox "他の人が作業中です。しばらく経ってから転記し直してください。" 28 wB.Close False 29 Exit Sub 30 Else 31 Set wS = wB.Sheets("list") 32 wB.Activate '←普通は必要ないが、一応。 33 wS.Activate 34 wS.Range("A1") = Now 35 End If 36 37 '②A入力用（転記元）のB列「*」の一つ下のC列からM列までをコピー 38 With ThisWorkbook.Worksheets("入力フォーム") 39 x = 4 40 Do While .Cells(x, 3).Value <> "" 41 If .Cells(x, 2).Value <> "*" Then 42 .Cells(x, 2).Value = "*" '----コピーと同時にB列へ転記すみ「*」を追記 43 .Range(.Cells(x, 3), .Cells(x, 13)).Copy 44 45 '③共有フォルダの「管理状況」にある集約管理へ転記 46 '----B列の最終ひとつ下を選択してから値として貼り付け 47 With wS.Cells(wS.Rows.Count, 2).End(xlUp).Offset(1, 0) 48 'wB.Activate '←Selectを使いたいときはコレも書いたほうが安全 49 'wS.Select '←Selectをｒｙ 50 '.Select '←省略可 51 .PasteSpecial Paste:=xlPasteValues, _ 52 Operation:=xlNone, SkipBlanks:=False, Transpose:=False 53 End With 54 End If 55 x = x + 1 56 Loop 57 End With 58 Application.CutCopyMode = False 59 60 'データの末尾の次の行を選択 61 wB.Activate 62 wS.Select 63 wS.Cells(wS.Rows.Count, 2).End(xlUp).Offset(1, 0).Select 64 65 Application.DisplayAlerts = False 66 wB.Save 67 Application.DisplayAlerts = True 68 wB.Close False '----元のファイルを保存し閉じる 69 70 MsgBox "転記しました。" 71 72 Workbooks.Open Filename:=myPath & fN, ReadOnly:=True '----読み取り専用で開く 73 74End Sub
尚、本件はこのように1行づつコピー＆貼り付けでも問題ないと思いますが、大量のデータを処理する場合は以下のような修正が必要です。
1.先に更新する行数を求めてから複数行をまとめて処理する。
2.コピー＆ペーストではなく値の直接転写を行う。
投稿2018/09/29 11:30
編集2018/09/29 12:05
退会済みユーザー
総合スコア0
0
②についてコメントしてます。
ActiveSheet.PasteSpecial Paste:=xlPasteValues, _ Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ActiveSheetが何を指しているのかイミディエイトウィンドウで確認し、
正しいSheetを指定するためのコード修正で解決すると思います。
＜イミディエイトウィンドウでの確認方法＞
Debug.Print ActiveSheet.name
投稿2018/09/29 10:39
編集2018/09/29 10:40
総合スコア1063
あなたの回答
tips
プレビュー
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
2018/09/30 02:18
退会済みユーザー
2018/09/30 03:41