Excel VBA質問箱 IV

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

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


4930 / 13646 ツリー ←次へ | 前へ→

【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 お礼[未読]

【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

よろしくお願いします。

【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件と表示されます。

試してみて下さい。

【53508】Re:誤入力の検索 再送
質問  Nishimura  - 08/1/18(金) 7:26 -

引用なし
パスワード
   ▼ichinose さん:

おはようございます。
早速ご回答有難うございました。
作業列を活用する方法で、感心しました。
J列に「1」が入り分かりやすいでした。
未だ、コードの理解まで出来ていませんが・・・
ただ、このような現象が出ます
      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行は使われています。
ただ顧客単位の集計により行数が異なるのです。
入力時に伝票の記入ミスやコードの入力ミスで顧客名が
間違えるのです。

ある意味ではArray処理でも出来るのかな?と思ったりしています。
今までは一顧客につき必ず2行が使われていたので、Autofilterの繰り返し
で、その都度複数行のチェックをさせる方法を活用していたのです。が
今回から最低行が1行の顧客が出てきて検出に間違った数字が出てきました。
よろしくお願いします。

【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

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

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

引用なし
パスワード
   ▼じゅんじゅん さん:
>▼Nishimura さん:
>>▼ichinose さん:
>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
>
>無駄な作業もあるかと思いますが、ご参考になれば幸いです。

ごめんなさい。
End With の後ろに
End Sub が抜けてました。

【53519】Re:誤入力の検索 再送
発言  ichinose  - 08/1/18(金) 19:06 -

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

>ただ、このような現象が出ます
>      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件と表示されますけどね!!

同期を取るためにサンプルデータもコードで記述します。
新規ブックにて、標準モジュールに
'============================================================
Sub main()
  Dim rng As Range
  Dim dif As Long
  Call mk_sample
  MsgBox "サンプルデータ作成しました Reday?"
  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
'==================================================================
Sub mk_sample()
  Cells.ClearContents
  Range("i8:i17").Value = _
   Application.Transpose(Array("AAAAAA", "AAAAAA", _
         "AAAAAA", "BBBBBB", "CCCCCC", "CCCCCC", _
         "CCCCCC", "DDDDDD", "CCCCCC", "CCCCCC"))
End Sub

として、適当なシートをアクティブにして試してみてください。

誤データは 1件と表示されますよ!!


>
>それから書き忘れましたが、会計処理はかなりルール化されて
>おり、顧客名の順番はいつも同じです。欠番はありません。
>   ~~~~~~~~~~~~~~~~~~~~~~~~  
>最小行でも1行は使われています。
>ただ顧客単位の集計により行数が異なるのです。
>入力時に伝票の記入ミスやコードの入力ミスで顧客名が
>間違えるのです。
>
>ある意味ではArray処理でも出来るのかな?と思ったりしています。
>今までは一顧客につき必ず2行が使われていたので、Autofilterの繰り返し
>で、その都度複数行のチェックをさせる方法を活用していたのです。が
>今回から最低行が1行の顧客が出てきて検出に間違った数字が出てきました。
>よろしくお願いします。

【53521】Re:誤入力の検索 再送
お礼  Nishimura  - 08/1/18(金) 23:03 -

引用なし
パスワード
   ▼ichinose さん:
今晩は。
サンプルまで作成していただき、誠に有難うございます。
確かにご指摘の通り、誤データは1件と出ました。
今、こちらの実際のデータで再度確認しました結果・・・両方を動作させて
問題点が分かりました。
これは、また説明不足でした。会計ソフトからエクセルに持ち込んだ(顧客単位の貼り付け繰り返し)データの顧客名がコード化されていて、登録されているコード
以外の顧客名が入力できません。ただ、1件の誤入力は2件の誤まりという結果に
なります。
 I    J
AAAAA
AAAAA
BBBBB
BBBBB
KKKKK
BBBBB   1
 :
 :
KKKKK   1
KKKKK 

ということだと分かりました。本当にお忙しいところお時間をかけて
ご説明頂き有難うございました。
「1件の誤データ」は2件を意味するということで
MsgBox "「誤データ」が " & Application.Count(.Cells) / 2 & "件(以上)です。"
で、正しくMSGBOXに表示できました。有難うございました。
このコードを貴重に使わせていただきます。

一般エクセルの知識不足もあり、それにしても
=IF(I24=I25,"",IF(COUNTIF(I$8:I25,I25)>1,1,""))
の関数はすごいですね。。。理解に時間がかかりそうです。
コードも一部完全に理解が出来ず歯がゆい思いですが、少しずつ
勉強させていただきます。
また聞かせていただくことがあると思いますが、この件に懲りずよろしくご指導のほどお願いします。
感謝感激です。失礼します。先ずは御礼まで。

【53524】Re:誤入力の検索 再送
質問  Nishimura  - 08/1/19(土) 12:08 -

引用なし
パスワード
   ▼じゅんじゅん さん:

お礼が遅くなりました。
サンプル添付有難うございました。
Sub try()
を実行させていただきました。
同じ顧客の件数がJ列に表示され、何かに活用できそうです。
ただ、データが500行余りなのですが・・・
何故か
14行目から156行目
にしか件数表示されませんが・・・何かおかしいのでしょうか?

【53525】Re:誤入力の検索 再送
発言  じゅんじゅん  - 08/1/19(土) 13:07 -

引用なし
パスワード
   ▼Nishimura さん:
>▼じゅんじゅん さん:
>
>お礼が遅くなりました。
>サンプル添付有難うございました。
>Sub try()
>を実行させていただきました。
>同じ顧客の件数がJ列に表示され、何かに活用できそうです。
>ただ、データが500行余りなのですが・・・
>何故か
>14行目から156行目
>にしか件数表示されませんが・・・何かおかしいのでしょうか?

特に行数に制限を設けてはいないのですけど。。。
157行目以降のデータに何かあるのか?
I列の最終行が取得できていないのか?

2回目の
>   For i = 1 To UBound(v, 1)
の前に
   Debug.Print UBound(v, 1), Dic.Count
を入れてみて、
行数:UBound(v, 1)
重複しない会社数:Dic.Count
を確認してみて下さい。

【53526】Re:誤入力の検索 再送
発言  Nishimura  - 08/1/19(土) 13:50 -

引用なし
パスワード
   ▼じゅんじゅん さん:
>特に行数に制限を設けてはいないのですけど。。。
>157行目以降のデータに何かあるのか?
>I列の最終行が取得できていないのか?
>
>2回目の
>>   For i = 1 To UBound(v, 1)
>の前に
>   Debug.Print UBound(v, 1), Dic.Count
>を入れてみて、
>行数:UBound(v, 1)
>重複しない会社数:Dic.Count
行数
 245
(8行目から252行目まで顧客名が入っています)
重複しない顧客数
 59
です。
現在14〜155まで件数が入っています。

【53527】Re:誤入力の検索 再送
発言  じゅんじゅん  - 08/1/19(土) 14:39 -

引用なし
パスワード
   ▼Nishimura さん:
>▼じゅんじゅん さん:
>>特に行数に制限を設けてはいないのですけど。。。
>>157行目以降のデータに何かあるのか?
>>I列の最終行が取得できていないのか?
>>
>>2回目の
>>>   For i = 1 To UBound(v, 1)
>>の前に
>>   Debug.Print UBound(v, 1), Dic.Count
>>を入れてみて、
>>行数:UBound(v, 1)
>>重複しない会社数:Dic.Count
>行数
> 245
>(8行目から252行目まで顧客名が入っています)
>重複しない顧客数
> 59
>です。
>現在14〜155まで件数が入っています。

ちょっとお手上げです。

こちらでは750行まで、提示されているデータを入れてみても件数はでました。
ので、実際のデータと何が違うのか不明です。

すいません。

【53528】Re:誤入力の検索 再送
お礼  Nishimura  - 08/1/19(土) 15:51 -

引用なし
パスワード
   ▼じゅんじゅん さん:
有難うございました。こちらで色々と調べてみます。
お手数をおかけして、申し訳けございませんでした。
これからもよろしくお願いします。

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