Excel VBA質問箱 IV

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

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


28522 / 76732 ←次へ | 前へ→

【53507】Re:誤入力の検索 再送
発言  ichinose  - 08/1/18(金) 0:38 -

引用なし
パスワード
   ▼Nishimura さん:
こんばんは。

>会計の集計ソフトからエクセルにデータを貼り付け、
>会計の入力が間違っていないかチェックさせるエクセルの表を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

作業列を使う方法です。下のコードでは、J列を作業領域として使っています。
J列が都合が悪ければ、作業列の場所を変更してください。

標準モジュールに

'==============================================================
Sub main()
  Dim rng As Range
  Dim dif As Long
  Set rng = Range("i8", Cells(Rows.Count, "i").End(xlUp))
  If rng.Row >= 8 Then
    With rng
     dif = .Column
     With .Offset(0, 1)
     '↑作業列はJ列 With .Offset(0, 3)とすればL列が作業列
       dif = dif - .Column
       .Value = ""
       With .Cells(2).Resize(.Rows.Count)
        .Formula = "=IF(r[-1]c[" & dif & _
              "]=rc[" & dif & "],"""",IF(COUNTIF(r" & _
              .Cells(0).Row & "c[" & dif & _
              "]:rc[" & dif & "],rc[" & dif & _
              "])>1,1,""""))"
        End With
       MsgBox "「誤データ」が " & Application.Count(.Cells) & "件(以上)です。"
       .EntireColumn.Value = ""
       End With
     End With
    End If
End Sub


対象シートをアクティブにした状態で
上記コードmainを実行してみてください。

      I


8    AAAAAA
9    AAAAAA
10   AAAAAA
11   BBBBBB
12   CCCCCC
13   CCCCCC
14   CCCCCC
15   DDDDDD

というデータなら、誤データ 0件と表示され、


      I


8    AAAAAA
9    AAAAAA
10   AAAAAA
11   BBBBBB
12   CCCCCC
13   CCCCCC
14   CCCCCC
15   DDDDDD
16   AAAAAA

なら、誤データ 1件と表示されます。

試してみて下さい。
1 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 お礼

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