ループを使いセルを一つ一つ見て文字列の差分確認はできるのですが、
何千行にもなると、処理が遅くなってしまうので、オブジェクト変数を
使って、プログラムを書く直しているのですが、どうも上手く行きません。
下記コードを実行すると、G列に全てNGとなってしまいます。。。
なぜ、この様な状態になってしまうのでしょうか？
どなたかご教授お願いいたいます。

<処理内容>
C列にある文字列がK列に無い場合は、G列に"NG"と入力する。
K列に合った文字列の場合には、G列は空白のまま。(何もしない）

vba
1Dim MyRange as Range
2 cnt = 3
3    
4    cRow = Cells(Rows.Count, "C").End(xlUp).Row
5    kRow = Cells(Rows.Count, "K").End(xlUp).Row
6    
7    Do While Cells(cnt, "C").Value <> ""
8        Set MyRange = Range(Cells(cnt, "K"), Cells(kRow, "K")).Find(what:=Cells(cnt, "C"))
9        If MyRange Is Nothing Then
10            Cells(cnt, "G").Value = "NG"
11        End If
12        cnt = cnt + 1
13    Loop

実行結果

行動規範の内容に同意します

回答2件

ベストアンサー

set MyRangeの行で、開始位置になぜcntをつかうのでしょうか。
cntを使うと現在比較しようとしている行から下しか検索しないと思います。
（だからC5のcccが対象の場合、行位置が上にあるK3にあるcccにヒットしない。）
そこは3でいいんじゃないでしょうか。
Set MyRange = Range(Cells(3, "K"), Cells(kRow, "K")).Find(what:=Cells(cnt, "C"))

投稿2017/01/14 06:28

退会済みユーザー

総合スコア0

退会済みユーザー

2017/01/14 13:07

有難うご御座います。小さなミスですが、自分では中々気づかないもんですね・・・・。

行動規範の内容に同意します

pipiさん、はじめまして。

既に解決済みとなっていますが、以下の点が気になりましたので。

何千行にもなると、処理が遅くなってしまうので、

ご存知であればよいのですが、ScreenUpdatingの指定は行っていますでしょうか。
例えば、次のサイトの情報がわかりやすいかと。思います。
Office TANAKA - Excel VBA高速化テクニック[無駄な表示を止める]

今回のケースに書き加えるとすると次のようにします。

Dim MyRange as Range
 cnt = 3

    cRow = Cells(Rows.Count, "C").End(xlUp).Row
    kRow = Cells(Rows.Count, "K").End(xlUp).Row

    Application.ScreenUpdating = False //描画を行わない
    Do While Cells(cnt, "C").Value <> ""
        Set MyRange = Range(Cells(3, "K"), Cells(kRow, "K")).Find(what:=Cells(cnt, "C"))

        If MyRange Is Nothing Then
            Cells(cnt, "G").Value = "NG"
        End If
        cnt = cnt + 1
    Loop
    Application.ScreenUpdating = True //描画を行う

また、例外対処のことを考えると次のようにするのがより望ましいと思います。

On Error GoTo Err //エラーが発生したらErrラベルへ飛ぶ
Dim MyRange as Range
 cnt = 3

    cRow = Cells(Rows.Count, "C").End(xlUp).Row
    kRow = Cells(Rows.Count, "K").End(xlUp).Row

    Application.ScreenUpdating = False //描画を行わない
    Do While Cells(cnt, "C").Value <> ""
        Set MyRange = Range(Cells(3, "K"), Cells(kRow, "K")).Find(what:=Cells(cnt, "C"))

        If MyRange Is Nothing Then
            Cells(cnt, "G").Value = "NG"
        End If
        cnt = cnt + 1
    Loop
Err: //エラーがあった場合、ここから再開
    Application.ScreenUpdating = True //描画を行う