前提・実現したいこと
Excel VBAで照合確認をしたい。
ここに質問の内容を詳しく書いてください。
照合確認をFor Nxstを使って、二つのシートのセルに同一のものがあれば、OKを出す。
発生している問題・エラーメッセージ
照合データ増減を考え、最終行を取得するコードを書いたが、自宅PCではデータが同一ならば、OKが問題なく表示。会社PCではデータが同一であるが、OKが表示しないものがある。
Sub 照合パッチシート基準()
Worksheets(1).Name = "パッチシート" Worksheets(2).Name = "イメージ貼り付け" Worksheets(3).Name = "イメージ整理" Sheets("イメージ貼り付け").Select Range("E:F").Select Selection.Copy Sheets("イメージ整理").Select Range("A1").Select ActiveSheet.Paste Worksheet("パッチシート").Range("H1").Value = "パッチシート" Worksheets("パッチシート").Range("I1").Value = "イメージシステム" Worksheets("パッチシート").Select Dim patch As Long Dim img As Long Dim ws1 As Worksheet Dim ws3 As Worksheet Dim cmax As Long cmax = Cells(Rows.Count, 1).End(xlUp).Row Set ws1 = Worksheets("パッチシート") Set ws3 = Worksheets("イメージ整理") For img = 2 To cmax For patch = 2 To cmax If ws3.Range("A" & img).Value = ws1.Range("E" & patch).Value Then ws1.Range("H" & patch).Value = "OK" Exit For End If Next Next For patch = 2 To cmax If ws1.Range("h" & patch).Value = "" Then ws1.Range("h" & patch).Value = "エラーもしくはパッチシートがあまってないですか?" ws1.Range("I" & patch).Value = "イメージ化されてないです。" Exit For End If Next Columns("H:H").ColumnWidth = 40
End Sub
試したこと
補足情報(FW/ツールのバージョンなど)
家と自宅のExcelバージョンは2016です。
気になる質問をクリップする
クリップした質問は、後からいつでもMYページで確認できます。
またクリップした質問に回答があった際、通知やメールを受け取ることができます。
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
karubo0920
2018/12/07 14:26
回答4件
0
照合データ増減を考え、最終行を取得するコードを書いたが、自宅PCではデータが同一ならば、OKが問題なく表示。会社PCではデータが同一であるが、OKが表示しないものがある。
こういう場合、原因は大体以下の2つです。
1)セルの指定が意図したセルと違う。(最終行の取得も含む)
2) 画面では同一に見えるが、実際の値は同一ではない。
なので、本当は、デバッグの方法を習うほうが有意義だと思いますが、
面倒なのでここでは、割愛します。
(別途、デバッグをテーマにして質問することをお勧めします)
で、とりあえず提示のコードを見た感想を書きます。
1)変数名は役割を想像しやすいものにする。
(個人的にわかればいいですが、ぼくにはわかりにくいです)
2)ループカウンターはシンプルな変数名に
3)最終的に操作するのは「セル範囲」なので、
セル範囲を変数に代入するように考える(セル範囲にはシートの情報も含まれている)
4)蛇足かもしれませんが、ここの掲示板では、
「変数の宣言は使う直前」的な流れがあるようですが、
デバッグ中読んでいて思考が止められちゃうので、
僕的には好みではありません。
5)本題でないものは、プロシージャの外に追い出す。
この辺に注意して、
練習なので何度でもコードを書いてみてはいかがでしょうか?
あとで、サンプルコード書けたら追記します。
VBA
1Option Explicit 2 3Sub test() 4 Dim i As Long 5 Dim j As Long 6 Dim c As Range 7 Dim r As Range 8 Dim flg As Boolean 9 10 '結果書き込みシートの初期化 11 With Worksheets(2) 12 .Cells.Clear 13 Worksheets(3).Range("E;F").Copy .Range("A1") 14 .UsedRange.Columns(3).Value = "NG" 15 End With 16 17 '同一データの存在確認をして結果を記録 18 With Worksheets 19 For i = 2 To .Item(1).Cells(.Item(1).Rows.Count, "A").End(xlUp).Row 20 Set c = .Item(1).Cells(i, "A") 21 If IsEmpty(c.Value) = False Then 22 flg = False 23 For j = 2 To .Item(2).Cells(.Item(2).Rows.Count, "E").End(xlUp).Row 24 Set r = .Item(2).Cells(j, "E") 25 If c.Value = r.Value Then 26 r.Offset(, 2).Value = "OK" 27 flg = True 28 Exit For 29 End If 30 Next 31 If flg = False Then 32 With .Item(2).Cells 33 .Item(j, "E").Value = c.Value 34 .Item(j, "G").Value = "Nothing" 35 End With 36 End If 37 End If 38 Next 39 End With 40End Sub
まずは、意図したセルを、意図したタイミングで指定できているかを、
コツコツ確認してみることをお勧めします。
投稿2019/01/05 01:27
編集2019/01/05 02:30総合スコア2136
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
0
リランした時に、前の残骸が残りますが、それをクリアしていません。
パッチシートのH、I列をクリアするようにしました。これで確認してみてください。
VBA
1Option Explicit 2 3Sub 照合パッチシート基準() 4 5 Worksheets(1).Name = "パッチシート" 6 Worksheets(2).Name = "イメージ貼り付け" 7 Worksheets(3).Name = "イメージ整理" 8 9 Sheets("イメージ貼り付け").Select 10 Range("E:F").Select 11 Selection.Copy 12 Sheets("イメージ整理").Select 13 Range("A1").Select 14 ActiveSheet.Paste 15 16 Worksheets("パッチシート").Range("H1").Value = "パッチシート" 17 Worksheets("パッチシート").Range("I1").Value = "イメージシステム" 18 19 Worksheets("パッチシート").Select 20 21 Dim patch As Long 22 Dim img As Long 23 Dim ws1 As Worksheet 24 Dim ws3 As Worksheet 25 Dim cmax As Long 26 27 cmax = Cells(Rows.Count, 1).End(xlUp).Row 28 29 Set ws1 = Worksheets("パッチシート") 30 Set ws3 = Worksheets("イメージ整理") 31'追加開始 32 For patch = 2 To cmax 33 ws1.Range("H" & patch).Value = "" 34 ws1.Range("I" & patch).Value = "" 35 Next 36'追加終了 37 For img = 2 To cmax 38 For patch = 2 To cmax 39 If ws3.Range("A" & img).Value = ws1.Range("E" & patch).Value Then 40 ws1.Range("H" & patch).Value = "OK" 41 Exit For 42 End If 43 Next 44 Next 45 46 For patch = 2 To cmax 47 If ws1.Range("h" & patch).Value = "" Then 48 ws1.Range("h" & patch).Value = "エラーもしくはパッチシートがあまってないですか?" 49 ws1.Range("I" & patch).Value = "イメージ化されてないです。" 50 Exit For 51 End If 52 Next 53 54 Columns("H:H").ColumnWidth = 40 55 56End Sub 57
投稿2019/01/08 01:33
総合スコア5424
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
0
投稿2018/12/25 14:49
編集2018/12/25 15:05karubo0920
総合スコア12
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
0
同じデータで違う動作をするということですが、おとなしく動かしていれば問題なさそうに見えます。
・処理中にシートやブックを切り替えたりしていませんか?
⇒シートを明示せずにセル参照している部分もありますので、タイミングによっては影響を受ける可能性があります。
・処理後に保存等せず、全く同じ状態のブックを双方の環境で動かしても結果に相違がでるのでしょうか?
⇒そうであれば環境依存の問題(Excelが壊れている等)の可能性もあります。
処理に不審な点がないか、解析してみました。
まず、序盤でSheet2⇒Sheet3にコピーを行っています。
その後、Sheet1のA列を対象に最終セルの行番号を取得し、ループ回数として変数に格納しています。
ループ処理①では、Sheet3を先ほどのループ回数だけ読み込み、Sheet1の一致する行にOK出力しています。
ループ処理②では、Sheet1のH列で最初に見つけた空欄に対しエラーメッセージを出力してループ終了しています。
以上の処理で、誤動作のキーとなりそうな部分としては
・Sheet1よりSheet3のデータ行が多い場合、全て処理されない
・Sheet1のA列にゴミセル(値を一度入力して消したなど)があると、最終行が変わる場合がある
※これは保存後、シート再表示すればゴミでなくなる
・最終行の取得の際、対象シートを明記していないので明記したほうが安全。
⇒最終行取得と最後の列幅設定をシート明示すればSheet1をSelectする必要はなくなり動作の安定につながります。
今のところ気になった点はこれくらいです。
意図していないところがないか、ご確認ください。
投稿2018/12/11 09:00
総合スコア3013
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
karubo0920
2018/12/14 13:45
2018/12/17 05:20 編集
2018/12/26 01:18 編集
karubo0920
2018/12/29 17:03 編集
2019/01/05 04:49
2019/01/07 07:21 編集
2019/01/07 07:11
2019/01/07 07:59 編集
2019/01/07 19:51
2019/01/08 00:16 編集
あなたの回答
tips
太字
斜体
打ち消し線
見出し
引用テキストの挿入
コードの挿入
リンクの挿入
リストの挿入
番号リストの挿入
表の挿入
水平線の挿入
プレビュー
質問の解決につながる回答をしましょう。 サンプルコードなど、より具体的な説明があると質問者の理解の助けになります。 また、読む側のことを考えた、分かりやすい文章を心がけましょう。