質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

88.58%

Excel VBAで照合確認をしたい。

受付中

回答 4

投稿 編集

  • 評価
  • クリップ 1
  • VIEW 4,304

karubo0920

score 8

前提・実現したいこと

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です。

  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 過去に投稿した質問と同じ内容の質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

質問への追記・修正、ベストアンサー選択の依頼

  • seastar3

    2018/12/07 05:00

    ここで日本語メッセージ等がやっと見えましたが、まだ余計な記述が残っていますよ。また、家のExcelのバージョンと会社のExcelのバージョンを示しましょう。

    キャンセル

  • karubo0920

    2018/12/07 23:26

    たびたび、申し訳ございません。質問の不備を改善しました。

    キャンセル

回答 4

+1

照合データ増減を考え、最終行を取得するコードを書いたが、自宅PCではデータが同一ならば、OKが問題なく表示。会社PCではデータが同一であるが、OKが表示しないものがある。

こういう場合、原因は大体以下の2つです。
1)セルの指定が意図したセルと違う。(最終行の取得も含む)
2) 画面では同一に見えるが、実際の値は同一ではない。

なので、本当は、デバッグの方法を習うほうが有意義だと思いますが、
面倒なのでここでは、割愛します。
(別途、デバッグをテーマにして質問することをお勧めします)

で、とりあえず提示のコードを見た感想を書きます。

1)変数名は役割を想像しやすいものにする。
(個人的にわかればいいですが、ぼくにはわかりにくいです)
2)ループカウンターはシンプルな変数名に
3)最終的に操作するのは「セル範囲」なので、
セル範囲を変数に代入するように考える(セル範囲にはシートの情報も含まれている)
4)蛇足かもしれませんが、ここの掲示板では、
「変数の宣言は使う直前」的な流れがあるようですが、
デバッグ中読んでいて思考が止められちゃうので、
僕的には好みではありません。
5)本題でないものは、プロシージャの外に追い出す。

この辺に注意して、
練習なので何度でもコードを書いてみてはいかがでしょうか?

あとで、サンプルコード書けたら追記します。

Option Explicit

Sub test()
    Dim i As Long
    Dim j As Long
    Dim c As Range
    Dim r As Range
    Dim flg As Boolean

    '結果書き込みシートの初期化
    With Worksheets(2)
        .Cells.Clear
        Worksheets(3).Range("E;F").Copy .Range("A1")
        .UsedRange.Columns(3).Value = "NG"
    End With

    '同一データの存在確認をして結果を記録
    With Worksheets
        For i = 2 To .Item(1).Cells(.Item(1).Rows.Count, "A").End(xlUp).Row
            Set c = .Item(1).Cells(i, "A")
            If IsEmpty(c.Value) = False Then
                flg = False
                For j = 2 To .Item(2).Cells(.Item(2).Rows.Count, "E").End(xlUp).Row
                    Set r = .Item(2).Cells(j, "E")
                    If c.Value = r.Value Then
                        r.Offset(, 2).Value = "OK"
                        flg = True
                        Exit For
                    End If
                Next
                If flg = False Then
                    With .Item(2).Cells
                        .Item(j, "E").Value = c.Value
                        .Item(j, "G").Value = "Nothing"
                    End With
                End If
            End If
        Next
    End With
End Sub

まずは、意図したセルを、意図したタイミングで指定できているかを、
コツコツ確認してみることをお勧めします。

参考URL>>
http://www.ken3.org/vba/excel-help.html

投稿

編集

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

0

同じデータで違う動作をするということですが、おとなしく動かしていれば問題なさそうに見えます。

・処理中にシートやブックを切り替えたりしていませんか?
⇒シートを明示せずにセル参照している部分もありますので、タイミングによっては影響を受ける可能性があります。

・処理後に保存等せず、全く同じ状態のブックを双方の環境で動かしても結果に相違がでるのでしょうか?
⇒そうであれば環境依存の問題(Excelが壊れている等)の可能性もあります。


処理に不審な点がないか、解析してみました。

まず、序盤でSheet2⇒Sheet3にコピーを行っています。

その後、Sheet1のA列を対象に最終セルの行番号を取得し、ループ回数として変数に格納しています。

ループ処理①では、Sheet3を先ほどのループ回数だけ読み込み、Sheet1の一致する行にOK出力しています。

ループ処理②では、Sheet1のH列で最初に見つけた空欄に対しエラーメッセージを出力してループ終了しています。


以上の処理で、誤動作のキーとなりそうな部分としては
・Sheet1よりSheet3のデータ行が多い場合、全て処理されない
・Sheet1のA列にゴミセル(値を一度入力して消したなど)があると、最終行が変わる場合がある
※これは保存後、シート再表示すればゴミでなくなる
・最終行の取得の際、対象シートを明記していないので明記したほうが安全。
⇒最終行取得と最後の列幅設定をシート明示すればSheet1をSelectする必要はなくなり動作の安定につながります。

今のところ気になった点はこれくらいです。

意図していないところがないか、ご確認ください。

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2019/01/07 16:57 編集

    例えばテスト結果ではG6セルが空欄になっていますが、H6セルまで値が入っており、C6セルにOKが出力されています。

    これはA6セルの値(5644235)に一致する値をパッチシートの上方からチェックしていき、5行目までループしたところで一致するセルも見つけたことを意味しています。
    そして4行目の結果(G6セル)には空欄が出力されています。
    ここから
    (a)パッチシートの4行目が空セルになっていた
    (b)パッチシートの4行目には正常値(124569)が入っていたが、なぜか別の空セルを参照・出力してしまった
    (c)正常値(124569)を取得したが、出力はなぜか空欄を出力してしまった
    (d)正常値(124569)を取得し、その値を一度は出力したが、その後何らかの処理で空欄に上書きされた
    といった状況が推測できます。

    (a)はその後の処理(G7セルなど)で正常値を取得・出力しているので考えにくそうです。
    (b)はロジック上その時だけ別セルが参照されるようなコードではないので、あるとすれば外的要因かなと。ここは再現性次第でしょうか。
    (c)もそのようなロジックではなく、このような動作になる外的要因もパッと思いつきません。メモリ破壊とか。。

    といったわけで現時点では(d)が一番濃厚と踏んでいるのですが、そうであれば外的要因としか思えませんので手を焼いております。

    もう少し検証情報をいただいて絞っていくしかなさそう、といった次第です。

    キャンセル

  • 2019/01/08 04:51

    「空欄になるセル」という事から固定箇所で再現性100%であると考えて、
    ・データはすべて正常でゴミセル等も皆無である、
    ・このコードを邪魔しそうなコードは存在しない、
    ・家では完全動作する
    が前提ですとそれしか考えられませんよね、
    だってコードは問題ないんですから…。

    でも下記を読む限り「単に適合しないデータが間に入って3件分ズレてるとかそんな落ちでは?」
    と思えてしまう。でも家では完全動作…。

    ・イメージデータのみにあるデータが3件
    ・イメージ整理のデータと同一でOKが出ない3件は最終行から数えて3件
    ・イメージ整理で空欄になるのは、③の3件とパッチシートにないデータ分の3件

    キャンセル

  • 2019/01/08 09:15 編集

    すみません。
    >・イメージ整理のデータと同一でOKが出ない3件は最終行から数えて3件
    この部分見落としてました。。これについては原因はわかります。

    変数`cmax`は、直前にアクティブにしたパッチシートA列から件数を取得しています。(226件)

    この変数`cmax`を使ってパッチシートもイメージシートもループしているので、パッチシートの方が件数が少なければイメージシートの最終3行は処理対象となりません。
    パッチシートとイメージシートの件数にズレがない、もしくはイメージシートの方が件数が少ないことを前提としたコードになっているのが原因と思われます。

    ただ、それでも
    ・両環境で動作に差異がある
    ・G6セル等が空欄となる
    ことについては謎が残りますね。

    キャンセル

0

リランした時に、前の残骸が残りますが、それをクリアしていません。
パッチシートのH、I列をクリアするようにしました。これで確認してみてください。

Option Explicit

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

    Worksheets("パッチシート").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 patch = 2 To cmax
        ws1.Range("H" & patch).Value = ""
        ws1.Range("I" & patch).Value = ""
    Next
'追加終了
    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

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

-1

ご回答、ありがとうございます。
問題確認コードで、空欄になるセルを画像で添付しました。イメージ説明

件数を減らして、セルG6、I9、K10に空欄になる。名前は、テスト名です。

デバックは詳しくはありませんが、ステップ実行とローカルウインドウを試してみたいと
思います。ローカルウインドウでどのようなエラーがたつと空欄になるのかご教示お願い致します。

※今回の処理ではパッチシートのE列に重複しているデータがあると、先に見つかる(上にある)行にのみOKが出力されますが、これが原因ではないですよね?

原因ではないと思います。

投稿

編集

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 88.58%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる

関連した質問

同じタグがついた質問を見る