Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


28531 / 76738 ←次へ | 前へ→

【53504】誤入力の検索
質問  Nishimura  - 08/1/17(木) 22:45 -

引用なし
パスワード
   会計の集計ソフトからエクセルにデータを貼り付け、
会計の入力が間違っていないかチェックさせるエクセルの表をVBAを活用したものです。
I列の8行目から顧客名が並んでいます。(最終的には500行くらいまで顧客名が詰まっています)
今までは顧客名が必ず最低2行同じ名称が並んでいました。
並んでいない場合は、このエクセルのVBAで会計ソフトの入力ミスのカウントを
させて、いました。
ところが最近データが最低1行のものも出てきて現在のコードでは問題点が出てきました。
コードを色々変えて試行錯誤したのですが、適切な動作が出来ません。
アドバイスお願いします。

今までのデータ  →  最近のデータ
  I列          I列
 AAAAA         AAAAAA 
 AAAAA         AAAAAA
 AAAAA         AAAAAA
 BBBBB         BBBBBB
 BBBBB         CCCCCC
 CCCCC         CCCCCC
 CCCCC         CCCCCC
 CCCCC         DDDDDD

入力ミスなし       入力ミスなしであるが
誤データ0件       誤データ2件→これを0件表示にさせたい

顧客名は並んで入力されていない場合は入力ミスです。
必ず顧客名が固まっている(一件だけの場合が出てきたのですが)、この表で
最後の列にAAAAAという顧客があれば入力ミスになります・・・Countされます)
同じ顧客名が離れた行に出るということは、語入力を検出させることが
本来の目的です。
説明が十分ではありませんが、コードとしては

Sub カウント()
Dim i As Long
Dim cnt As Long
 Application.ScreenUpdating = False
  For i = 8 To Range("I65536").End(xlUp).Row 
     Columns("I:I").AutoFilter _
      Field:=1, Criteria1:=Cells(i, 9).Value
    'もしCountが1であっても、cntは0とするを付け加えたいのですが・・・
     If ActiveSheet.UsedRange.Columns(9). _
      SpecialCells(xlCellTypeVisible).Count - 1 = 1 Then   
      cnt = cnt + 1
     End If
  Next i
  ActiveSheet.AutoFilterMode = False 
  MsgBox "「誤データ」が " & cnt & "件(以上)です。"      
 Application.ScreenUpdating = True
End Sub

よろしくお願いします。
0 hits

【53504】誤入力の検索 Nishimura 08/1/17(木) 22:45 質問
【53507】Re:誤入力の検索 再送 ichinose 08/1/18(金) 0:38 発言
【53508】Re:誤入力の検索 再送 Nishimura 08/1/18(金) 7:26 質問
【53509】Re:誤入力の検索 再送 じゅんじゅん 08/1/18(金) 9:42 発言
【53510】Re:誤入力の検索 再送 じゅんじゅん 08/1/18(金) 9:47 発言
【53524】Re:誤入力の検索 再送 Nishimura 08/1/19(土) 12:08 質問
【53525】Re:誤入力の検索 再送 じゅんじゅん 08/1/19(土) 13:07 発言
【53526】Re:誤入力の検索 再送 Nishimura 08/1/19(土) 13:50 発言
【53527】Re:誤入力の検索 再送 じゅんじゅん 08/1/19(土) 14:39 発言
【53528】Re:誤入力の検索 再送 Nishimura 08/1/19(土) 15:51 お礼
【53519】Re:誤入力の検索 再送 ichinose 08/1/18(金) 19:06 発言
【53521】Re:誤入力の検索 再送 Nishimura 08/1/18(金) 23:03 お礼

28531 / 76738 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free