Excel VBA質問箱 IV

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

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


28520 / 76732 ←次へ | 前へ→

【53509】Re:誤入力の検索 再送
発言  じゅんじゅん  - 08/1/18(金) 9:42 -

引用なし
パスワード
   ▼Nishimura さん:
>▼ichinose さん:
>      I      J
>
>8    AAAAAA
>9    AAAAAA
>10   AAAAAA
>11   BBBBBB
>12   CCCCCC
>13   CCCCCC
>14   CCCCCC
>15   DDDDDD     1
>16   CCCCCC     1 
>17   CCCCCC
>
>誤データが2件と出ます。
>実はCCCCCの塊の中にDDDDDが1件混じりこんでいるので
>1件が正しいのですが・・・
>
>それから書き忘れましたが、会計処理はかなりルール化されて
>おり、顧客名の順番はいつも同じです。欠番はありません。
>   ~~~~~~~~~~~~~~~~~~~~~~~~  
>最小行でも1行は使われています。
>ただ顧客単位の集計により行数が異なるのです。
>入力時に伝票の記入ミスやコードの入力ミスで顧客名が
>間違えるのです。

横から失礼します。

ある顧客範囲の中に別の顧客が何件入っているか?
と言うのをJ列に件数で表示するサンプルです。

Sub try()
Dim Dic As Object
Dim r As Range
Dim v, key
Dim i As Long

Set Dic = CreateObject("Scripting.Dictionary")

With ActiveSheet
   v = .Range(.Range("I8"), .Cells(Rows.Count, "I").End(xlUp))
  
   For i = 1 To UBound(v, 1)
     If Not Dic.exists(v(i, 1)) Then
       Dic(v(i, 1)) = Array(i + 7, i + 7)
     Else
       Dic(v(i, 1)) = Array(Dic(v(i, 1))(0), i + 7)
     End If
   Next
  
   For i = 1 To UBound(v, 1)
     For Each key In Dic.keys
       If v(i, 1) <> key Then
         Set r = .Range("I" & Dic(key)(0), "I" & Dic(key)(1))
         If Not Intersect(.Range("I" & i + 7), r) Is Nothing Then
          .Range("J" & i + 7).Value = _
          WorksheetFunction.CountIf(r, v(i, 1))
         End If
       End If
     Next
   Next
   Set Dic = Nothing
   Set r = Nothing
End With

無駄な作業もあるかと思いますが、ご参考になれば幸いです。

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 お礼

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