Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 11 Home : Microsoft 365)
検索 WorksheetFunction CountIf
投稿日時: 23/12/09 19:37:07
投稿者: ahiruchantoneko
メールを送信

以前は、for nextで行っていましたが、ワークシート関数が高速であることを知り、ネットで調べながらCountIf関数を組み込んでみました。
ですが実際に動かしてみると意図した結果にならず困っております。
お分かりになる方、何卒よろしくお願いします。
 
WS1のT列にある10桁の数字とWS2のC列にある10桁の数字が合致すれば、
WS1のAB列とWS2のD列に済を入力、合致しない場合や既に済がついている場合は何もしない。
 
WS1は0211111112の10桁、WS2は211111112と9桁表示の場合でも済になったり、ならなかったりしてしまいます。
お分かりになる方、何卒よろしくお願いします。
 
Sub 番号の照合()
 
    Dim WB1 As Workbook
    Dim WS1 As Worksheet
    Dim WS2 As Worksheet
 
    Set WB1 = ThisWorkbook
    Set WS1 = WB1.Worksheets(1)
    Set WS2 = WB1.Worksheets(3)
 
    Dim LastRowD1 As Long
    Dim LastRowD2 As Long
    Dim k1 As Long
    Dim k2 As Long
    Dim cellValue2 As String
    Dim count2 As Long
 
    ' WS2のC列の最終行を取得
    LastRowD1 = WS2.Cells(WS2.Rows.count, "C").End(xlUp).Row
 
    ' WS2のC列とD列をループ処理
     
   For k1 = 2 To LastRowD1
    ' C列が10桁の数字でD列が空白であるかチェック
    If Len(WS2.Cells(k1, "C").Value) = 10 And WS2.Cells(k1, "D").Value = "" Then
        ' D列に"済"
        If Application.WorksheetFunction.CountIf(WS1.Range("T:T"), WS2.Cells(k1, "C")) > 0 Then
            WS2.Cells(k1, "D").Value = "済"
        End If
    End If
Next k1
 
LastRowD2 = WS1.Cells(WS1.Rows.count, "T").End(xlUp).Row
' WS1のT列とAB列をループ処理
For k2 = 4 To LastRowD2
    ' AB列が空白であるかチェック
    If Len(WS1.Cells(k2, "T").Value) = 10 And WS1.Cells(k2, "AB").Value = "" Then
        ' AB列に"済"または空白を入力
        If Application.WorksheetFunction.CountIf(WS2.Range("C:C"), WS1.Cells(k2, "T:T")) > 0 Then
            WS1.Cells(k2, "AB").Value = "済"
 
        End If
    End If
Next k2
End Sub

回答
投稿日時: 23/12/09 22:36:22
投稿者: simple

コードだけだと、コードのとおりに動くだろう、としか思えませんので、
うまくいかない例を示してもらえますか?
想定結果(こうなって欲しい)と実際の結果(こんなことになってしまう)を示してください。
    Sheet1

    A列      B     C 
1行
2
3
のように行番号、列番号がわかるようにしてください。
表の範囲を選択して、[コード]ボタンをクリックすると、崩れにくいと思います。
 
こうしてもらうと、皆さんからも指摘が入りやすく、議論しやすいと思います。

回答
投稿日時: 23/12/09 22:38:50
投稿者: WinArrow

一寸、気になったところ
 
>If Application.WorksheetFunction.CountIf(WS2.Range("C:C"), WS1.Cells(k2, "T:T")) > 0 Then

回答
投稿日時: 23/12/09 22:48:48
投稿者: WinArrow

>WS2は211111112と9桁表示の場合でも済になったり、
の説明に対しては、
ステップ実行でわかるかもしれません。

投稿日時: 23/12/10 10:18:21
投稿者: ahiruchantoneko
メールを送信

ご返信をいただき、ありがとうございました。
また、質問方法に関する具体的なご提案をいただき、感謝申し上げます。
 
作業を進める中で気づいたのですが、sheet1のT列の表示形式が標準である一方、sheet2のC列は文字列として設定されていることが判明いたしました。これにより、データの照合に何らかの影響はあるのでしょうか?
 
お忙しいところ恐れ入りますが、表示形式が照合作業に与える影響について、何かご存知の情報がございましたら、ご教示いただけますと幸いです。
何卒よろしくお願いいたします。
 
【実行結果は下記の状態です】
 sheet1              
    T列        AB列    
1行     211111112        
2行    0211111113    済
 
 sheet3    
    C列        D列
1行    0211111112    済
2行    211111113    
    
1行目は不一致のため空白にしたいがD列に済がついてしまう
2行目は不一致のため空白にしたいがAB列に済がついてしまう
 
【下記、ご指摘いただきました列の指定を、開始行から最終行に変更いたしました】
Sub 番号の照合()
 
    Dim WB1 As Workbook
    Dim WS1 As Worksheet
    Dim WS2 As Worksheet
 
    Set WB1 = ThisWorkbook
    Set WS1 = WB1.Worksheets(1)
    Set WS2 = WB1.Worksheets(3)
 
    Dim LastRowD1 As Long
    Dim LastRowD2 As Long
    Dim k1 As Long
    Dim k2 As Long
    Dim cellValue2 As String
    Dim count2 As Long
 
    ' WS2のC列の最終行を取得
    LastRowD1 = WS2.Cells(WS2.Rows.Count, "C").End(xlUp).Row
    LastRowD2 = WS1.Cells(WS1.Rows.Count, "T").End(xlUp).Row
    ' WS2のC列とD列をループ処理
     
   For k1 = 2 To LastRowD1
    ' C列が10桁の数字でD列が空白であるかチェック
    If Len(WS2.Cells(k1, "C").Value) = 10 And WS2.Cells(k1, "D").Value = "" Then
        ' D列に"済"
        If Application.WorksheetFunction.CountIf(WS1.Range("T4:T" & LastRowD2), WS2.Cells(k1, "C")) > 0 Then
            WS2.Cells(k1, "D").Value = "済"
        End If
    End If
Next k1
 
 
' WS1のT列とAB列をループ処理
For k2 = 4 To LastRowD2
    ' AB列が空白であるかチェック
    If Len(WS1.Cells(k2, "T").Value) = 10 And WS1.Cells(k2, "AB").Value = "" Then
        ' AB列に"済"または空白を入力
        If Application.WorksheetFunction.CountIf(WS2.Range("C2:C" & LastRowD1), WS1.Cells(k2, "T")) > 0 Then
            WS1.Cells(k2, "AB").Value = "済"
        End If
    End If
Next k2
End Sub

回答
投稿日時: 23/12/10 11:33:10
投稿者: simple

頭に0が付くなら、普通は文字列書式にしておいてコードを入力すると思います。
 
A1,B1ともに文字列書式として、

    A列         B列         C列
1   0211111112  211111112   =COUNTIF(B1,A1)
とするとC1は1が返ると思います。
このことは、あなたの比較目的にCOUNTIFが適切ではないのではないかと思いますが、
いかがですか。
そもそもですが、それらはなんらかのコードなんですか?
9桁と10桁が混在しているんですか?10桁にそろえるといったことはしないのですか?
皆さんからコメントがないようなので、まずはその点だけコメントします。

回答
投稿日時: 23/12/10 12:18:29
投稿者: O.M

外のスレッドで質問中のものなのですが、いろいろエラー出しまくって息抜きに
スレッドを見てしまって比較方法はあっているのかと気になっていました。
  

引用:
1行目は不一致のため空白にしたいがD列に済がついてしまう
2行目は不一致のため空白にしたいがAB列に済がついてしまう

 
  
間違っていたらすみません。
  
上記コメントを見てC2とT4文字列を比較、C3とT5の文字を比較したいのではないかと思ったのですが、
式は「指定した範囲に一致する文字が1個以上あったら済」という
式になっているからではないでしょうか?
  
IF Application.WorksheetFunction.CountIf(WS1.Range("T4:T" & LastRowD2), WS2.Cells(k1, "C")) > 0
  WS2.Cells(k1, "D").Value = "済"
End If

 
  
このk1が2の場合、
「T4セルからT列の最終行までの間に、C2セルと同じ文字が0より多くあれば済をつける」
という内容で、C2と同じ文字がT列の範囲に1個以上あれば済になる式ではないでしょうか?
(10行目だろうが20行目だろうが同じ文字があれば済が付く)
  
例示の場合、済が付くつかないは桁数の条件の方で変わっているのではないかと…。
思い浮かべているCountIfの関数をセルに書き込んでみるとわかりやすいと思います。
  
シートの指定がインデックス番号のためシート名がわからないためシート名が仮に指定し、
最終行が100としてかくと行いたかったのは
=COUNTIF(Sheet3!T4:T100,Sheet1!C2)

 
ではなく
=COUNTIF(Sheet3!T4,Sheet1!C2)

 
かなと。
  
コードでいうと、
IF Application.WorksheetFunction.CountIf(WS1.Cells(K1+2  ,"T"), WS2.Cells(k1, "C")) > 0
  WS2.Cells(k1, "D").Value = "済"
End If

 
  
        If Application.WorksheetFunction.CountIf(WS2.Cells(K2-2 & "C"), WS1.Cells(k2, "T")) > 0 Then
            WS1.Cells(k2, "AB").Value = "済"
        End If

 
になる気がします。
  
表ですが、
  
 sheet1   
    T列     AB列
4行 211111112
5行 0211111113 済
  
 sheet3
    C列     D列
2行 0211111112 済
3行 211111113

  
という表だと判断してかいています。
  
  
  
あと気になったのですが、シートの指定でインディックス番号を使用していますが、
並び順は固定ですか…?
私はまれに、シートの並び順をマウス動作を間違えて動かしてしまうことがあるのでちょっと気になりました。
https://sugoikaizen.com/excelvba/2_89/
  
  
  
’速度アップ処理の内容がわかりやすいと思うサイト様
https://excel-ubara.com/excelvba5/EXCELVBA210.html
  
Sub 番号の照合()
 
    Dim WB1 As Workbook
    Dim WS1 As Worksheet
    Dim WS2 As Worksheet
 
    Set WB1 = ThisWorkbook
    Set WS1 = WB1.Worksheets(1)
    Set WS2 = WB1.Worksheets(3)
 
    Dim LastRowD1 As Long
    Dim LastRowD2 As Long
    Dim LastRowD As Long
    Dim k1 As Long

'処理速度UP処理 
  Application.ScreenUpdating = False '画面描画を停止
  Application.EnableEvents = False 'イベントを抑止
  Application.Calculation = xlCalculationManual '計算を手動に
 
    ' WS2のC列の最終行を取得
    LastRowD1 = WS2.Cells(WS2.Rows.Count, "C").End(xlUp).Row
    ' WS1のT列の最終行を取得
    LastRowD2 = WS1.Cells(WS1.Rows.Count, "T").End(xlUp).Row
    'WS2が2行目開始、WS1が4行目開始のため、1行目開始として最終行を比較し小さい方を最終行とする
    '※片方が空白の場合、比較しても済にならないため
    If LastRowD1 - 2 < LastRowD1 - 4 Then
      LastRowD = LastRowD1 - 2
    Else
      LastRowD = LastRowD2 - 4
    End If
    '行が1より少ない場合終了
    If LastRowD < 1 then exit sub
    
    ' WS2のC列とD列をループ処理
     
   For k1 = 1 To LastRowD
    ' C列が10桁の数字であるかチェック ※文字列の比較の場合は文字が同じのはずなので片方だけでOK
    If Len(WS2.Cells(k1 + 2, "C").Value) = 10 Then
        If Application.WorksheetFunction.CountIf(WS1.Cells(k1 + 4, "T"), WS2.Cells(k1 + 2, "C")) > 0 Then
          'WS2のD列が空白ではない場合は"済" K1 +2 は行指定
          If WS2.Cells(k1 + 2, "D").Value = "" Then WS2.Cells(k1 + 2, "D").Value = "済"
          'WS1のAB列が空白ではない場合は"済"
          If WS1.Cells(k1 + 4, "AB").Value = "" Then WS1.Cells(k1 + 4, "AB").Value = "済"
        End If
    End If
Next k1

'処理速度UP処理もどす ※計算を手動更新にしている場合はApplication.Calculationの項目は消す
  Application.Calculation = xlCalculationAutomatic '計算を自動に
  Application.EnableEvents = True 'イベントを開始
  Application.ScreenUpdating = True '画面描画を開始
 
End Sub

  
※速度アップでいうなら配列にしてシートに一気に貼り付けにするといいかもしれません。
http://officetanaka.net/excel/vba/speed/s11.htm

回答
投稿日時: 23/12/10 12:51:07
投稿者: O.M

もしかしたらご存じないのではと思ってしまったので記載します。
ご存じでしたら申し訳ございません。
※自分が理解できないことが多いタイプなので自分基準で考えてしまいました。
   
ブレークポイントをつくってステップ実行しウォッチウインドウでデータの確認をすると
間違いを見つけやすい気がします。
ウォッチウインドウ
https://asatte.biz/vba-watch/
https://excel-ubara.com/excelvba1/EXCELVBA488.html
ブレークポイント・ステップ実行
https://excel-ubara.com/excelvba1/EXCELVBA490.html
 

回答
投稿日時: 23/12/10 15:30:03
投稿者: simple

なんとかの一つ覚えで、私ならdictionaryを使います。
参考にしてください。

Sub 番号の照合()
    Dim ws1   As Worksheet
    Dim ws2   As Worksheet

    Dim dic1  As Object
    Dim dic2  As Object
    Dim ary1
    Dim ary2
    Dim lastRow1 As Long
    Dim lastRow2 As Long
    Dim s     As String
    Dim k     As Long
    Dim t
    t = Timer

    Set ws1 = ThisWorkbook.Worksheets(1)
    Set ws2 = ThisWorkbook.Worksheets(2)
    lastRow1 = ws1.Cells(ws1.Rows.Count, "T").End(xlUp).Row
    lastRow2 = ws2.Cells(ws2.Rows.Count, "C").End(xlUp).Row

    ary1 = ws1.Range("AB1", ws1.Cells(lastRow1, "AB"))
    ary2 = ws2.Range("D1", ws2.Cells(lastRow2, "D"))

    ' dictionaryの作成
    Set dic1 = CreateObject("Scripting.Dictionary")
    Set dic2 = CreateObject("Scripting.Dictionary")
    For k = 4 To lastRow1
        dic1(ws1.Cells(k, "T").Text) = Empty
    Next
    For k = 2 To lastRow2
        dic2(ws2.Cells(k, "C").Text) = Empty
    Next

    ' 予め初期化しておく(洗い替え処理のほうがスッキリすると思います)
    ws1.Columns("AB").ClearContents
    ws2.Columns("D").ClearContents

    '他のシート中にあれば、"済"表示を書き込む
    For k = 4 To lastRow1
        s = ws1.Cells(k, "T").Text
        If Len(s) = 10 Then
            If dic2.Exists(s) Then
                ary1(k, 1) = "済"
            End If
        End If
    Next

    For k = 2 To lastRow2
        s = ws2.Cells(k, "C").Text
        If Len(s) = 10 Then
            If dic1.Exists(s) Then
                ary2(k, 1) = "済"
            End If
        End If
    Next
    
    '結果を書き込む
    ws1.Range("AB1", ws1.Cells(lastRow1, "AB")) = ary1
    ws2.Range("D1", ws2.Cells(lastRow2, "D")) = ary2
    Debug.Print Timer - t
End Sub
できたら、元のコードでも同じように処理時間を測定して、結果を書いていただきたい。

投稿日時: 23/12/10 15:59:56
投稿者: ahiruchantoneko
メールを送信

>頭に0が付くなら、普通は文字列書式にしておいてコードを入力すると思います。
>9桁と10桁が混在しているんですか?10桁にそろえるといったことはしないのですか?
>比較目的にCOUNTIFが適切ではないのではないかと思います
 
ご意見をいただきありがとうございます。
私自身、相談できる方がおらず、このようなご指摘をいただけるのは大変ありがたいです。
検索番号は10桁の数字で構成されております。ご提案の通り、最初から10桁の数字でなければ入力できないような仕組みに変更いたします。
また、比較の目的にCOUNTIF関数以外が適切ではないかと思いましたので、別の方法も探してみたいと思います。

回答
投稿日時: 23/12/10 16:10:34
投稿者: simple

別の方法を提案しましたよ。

回答
投稿日時: 23/12/10 17:04:44
投稿者: WinArrow

以下は、メモです。
 
表示形式の件
数式(関数を含むう)では表示形式を参照しないと考えておきましょう。
 
文字列と数値の比較
 
COUNTIFに関しては、文字列と数値の比較は、OKと思います。
他の関数は、・・・・例えば、VLOOKUPkん数、MATCH関数はNG(アンマッチになる)

投稿日時: 23/12/10 17:18:09
投稿者: ahiruchantoneko
メールを送信

丁寧なお返事をいただき、ありがとうございます。
ご教示いただいたコードを用いて、照合作業完了することができました。
sheet1は4行目から始まります、お手数をおかけしてしまい、申し訳ありませんでした。
シートのインデックスにつきましては、誤作動を防ぐためにシート名を明記するように修正いたします。
また、提案していただいた比較方法など、私自身では、そのようなコードを考えることができませんでしたので、大変勉強になりました。
イミデイトウィンドウやウォッチウインドウの使用については、実践できていないのが現状ですので、確認する習慣を身につけたいと思います。
参考のリンクを添付していただき、ありがとうございました。大変役に立ちました。
 

投稿日時: 23/12/10 17:38:33
投稿者: ahiruchantoneko
メールを送信

まさに私が疑問に思っておりました点です。
VLOOKUPやMATCHでは不一致が生じる原因について悩んでおりましたが
客観的なご説明をいただくことで、疑問が解消されました。
コメントをいただき、誠にありがとうございました。

投稿日時: 23/12/10 17:39:22
投稿者: ahiruchantoneko
メールを送信

この度はご返信いただき、誠にありがとうございます。
dictionaryに関するお話は以前から耳にしておりましたが、実際にご提供いただいたコードを拝見し、その内容に触れることができたのはこれが初めてです。
WS1では1,050件、WS2では228件の照合作業を行い、イミディエイトウィンドウに表示された9.76356という数値について、様々なパターンで検証を重ねた結果、思い通りの照合結果を得られ、処理速度の速さにも驚嘆しております。
Dictionaryについては、まだ理解しておりませんが、この機会に深く学んでみたいと考えております。貴重な情報をお教えいただき、心より感謝申し上げます。