VBA構築の件

Question

添付ファイルをご参照ください。B,E列で同じ品番のもので、新たに顧客No違いのものがD列内に追加されています。この追加分のみに対し、F列でフラグ：１を立てるというシンプルなVBAを構築したいのですが、うまくできずに困っています。。
関数でフラグを付与させることも考えましたが、データ量が多い為処理が遅くなることを懸念し、VBAでの処理を考えています。
どのようにVBAを構築すればよいかをご教示ください。よろしくお願いいたします。

Qchan1962 · Accepted Answer

こんばんは、
簡単そうな処理の様に思われますが、その前に考えなくてはいけない事があるように思います。
＞データ量が多い　のであれば、ボタンを押下処理で行う場合、全データを処理し直す事になるのではないでしょうか？それともフラグが空白のみを判断して処理をするのでしょうか？または、ボタンでデータ自体を追加する処理がありその処理に加える構想でしょうか？

いずれにしても、多少ファイルが重くなるにしても数万データあるのなら、
照合元でも照合先でも一意になるデータセルを作れれば、（例えばC列、AA列でも良いですが、数式が重ければ、VBAで値でも）VBAの処理の負担が減ると思います。ただ、VBAの中で作っても良いのですが、、

要望とは、違う形ですが色々なものを？入れた最小単位のサンプルです。
サンプルは、対象のシートモジュールに書きます。
図の構成の時、F列のセルをダブルクリックするとそのセルに結果が出力されるものです。
IFの左辺は配列にしています。
また、仮にC列にA列＆B列の値があった時の処理を参考として追記しています。Target.Offset(, -2) は、D列、Target.Offset(, -1) は、E列を示しているので　全行に対して実行する場合は、Cells(ループ変数,"D")のようにすれば、処理できると思います。
2重ループにする場合は、GoTo TrueEndをExit Forに変え、一致した時にいち早く次の処理に移るようにします。出来るのであれば、データを降順などに並び替えて一致を探すループ回数を減らすように考えると良いと思います。

悪い癖で長文になってしまいました。参考程度で

Private Sub Worksheet_BeforeDoubleClick _
　　  (ByVal Target As Range, Cancel As Boolean)
　 If Intersect(Target, Columns(6)) Is Nothing Then Exit Sub
　 Cancel = True
　 Dim Ary
　 Dim i As Long, LsRow As Long
　 LsRow = Cells(Rows.Count, "E").End(xlUp).Row
　 Ary = Range(Cells(1, "A"), Cells(LsRow, "B"))
　 Application.ScreenUpdating = False
　 For i = 1 To UBound(Ary, 1)
　　  If Ary(i, 1) & Ary(i, 2) = Target.Offset(, -2) & Target.Offset(, -1) Then
　　　　Target = ""
　　　　GoTo TrueEnd
　　  Else
　　　　Target = 1
　　  End If
　 Next
TrueEnd:
　 Application.ScreenUpdating = True
End Sub

C列に書き出してあればFor～Nextは不要

If Application.CountIf _
    (Columns(3), Target.Offset(, -2) & Target.Offset(, -1)) > 0 Then
        Target.Value = ""
        Else
        Target.Value = 1
    End If

fujillin · Answer

こんばんは

＞関数でフラグを付与させることも考えましたが、
＞データ量が多い為処理が遅くなることを懸念し
どのくらいのデータ量か不明ですが、以下の関数利用の方法で試してみたところ、A:B列は10000行、D:E列は1000行のデータ量で、私の環境（←遅くはありませんが）では、約0.2秒で処理が終わりました。
環境にもよるので何とも言えませんが、上記データ量程度であれば、数秒かからずに終わるのではないでしょうか？

以下、ご参考まで。

Sub Sample_12187689()
Dim rng As Range, fn As String
Const f = "=IF(COUNTIFS(@1,D2,@2,E2),"""",1)"

Application.ScreenUpdating = False
Set rng = Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))
fn = Replace(Replace(f, "@1", rng.Address), "@2", rng.Offset(, 1).Address)

Set rng = Range(Cells(2, 4), Cells(Rows.Count, 4).End(xlUp)).Offset(, 2)
If rng(1).Row < 2 Then Exit Sub
rng.FormulaLocal = fn
rng.Value = rng.Value

Application.ScreenUpdating = True
End Sub

※ 最初の f が関数文字列（F2セル用）ですので、これを変更することで内容の変更も可能です。
　@1にはA列の範囲の絶対参照が、@2にはB列の範囲の絶対参照が入ります。

＞No6様
　Filter利用は面白いアイデアですが、B、E列の比較も必要と思われますので、もう一工夫必要になりそうな気がします。

ママチャリ · Answer

こんなのが面白いかな！！

Sub sample()
    With Range("F2:F" & Cells(Rows.Count, "E").End(xlUp).Row)
        .Value = "1"
        Range("D1").CurrentRegion.AdvancedFilter _
            Action:=xlFilterInPlace, _
            CriteriaRange:=Range("A1").CurrentRegion
        .ClearContents
    End With
    ActiveSheet.ShowAllData
End Sub

tatsumaru77 · Answer

D,E列に顧客No=ZZ、品番＝33333のような、B列にない品番があった場合は、どうするのでしょうか。

Qchan1962 · Answer

#3です。
偶然、VBA COUNTIFS高速　で検索していたらご質問にあった解説サイトを見つけました。
サンプルコードは少し難しいかも知れませんが、少し手を加えれば使えそうですし、しっかり解説もあります。
検証はしておりませんが参考になるかも知れません。

https://officedic.com/excel-vba-countifs-dic/

ppp2122 · Answer

あと　添付ってどこに添付されてるの？
ここは　ファイルの添付など出来ないはずだけど

ppp2122 · Answer

sub 新規チェック()

Dim 値1 As String,値2 As String, 値3 As String,値4 As String,値0 As String
Dim i As Long,Endrow As Long
値1=Cells(2,1).Text And Cells(2,2).Text
値2=Cells(3,1).Text And Cells(3,2).Text
値3=Cells(4,1).Text And Cells(4,2).Text
値4=Cells(5,1).Text And Cells(5,2).Text

Endrow=Cells(1048576,4).End(Xlup).Row
For i = 2 to Endrow
値0=Cells(i,4).Text And Clees(i,5).Text
If 値0<>値1 And 値0<>値2 And 値0<>値3 And 値0<>値4 Then
Cells(i,6).Value=1
End if
Next i

これならどう？

VBA構築の件

こんばんは、

こんばんは

こんなのが面白いかな！！

D,E列に顧客No=ZZ、品番＝33333のような、B列にない品番があった場合は、どうするのでしょうか。

#3です。

あと 添付ってどこに添付されてるの？

sub 新規チェック()

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

あと　添付ってどこに添付されてるの？