[[20200116224022]]　『VBA countifによる処理』（天）　ページの最後に飛ぶ

『VBA countifによる処理』（天）

宜しくお願いします。

Sub test()

    Dim r As Range
   Set r = Worksheets("test").Cells(1).CurrentRegion
    'CurrentRegionはデータがあるセルを取得する
   With r.Columns(7)
       .Formula = "=if(or(countif(A:A,E1)),true,"""")"
       .Value = .Value
       .SpecialCells(xlCellTypeConstants) = "ok"        
   End With

End Sub

このコードでA列すべてのデータに対してE列のデータが存在するかチェックしています。
追加でやりたいことは
同時にB列すべてのデータに対してF列のデータもチェックしたいのですが
それが分からずご教授ください。

4万件データがありかなり遅いのでもっと早い処理があれば
おしえて頂けると助かります。

＜使用 Excel：Excel2016、使用 OS：Windows10 ＞

       .Formula = "=IF(COUNTIF(A:A,E1),""ok"","""")"
       .Value = .Value
  ではダメなんですか？
　＞同時にB列すべてのデータに対してF列のデータもチェックしたいのですが
　まったく同じようにすればよいのでは？
（γ） 2020/01/17(金) 08:37

 データが4万件くらいなら・・
 Sub TEST2()
    Dim Data, fData
    Dim n As Long, i As Long
    With Worksheets("test")
        For n = 1 To 2
            Data = WorksheetFunction.Transpose(.Columns(n).Value)
            For i = 1 To .Cells(.Rows.Count, n + 4).End(xlUp).Row
                fData = Filter(Data, .Cells(i, n + 4).Value)
                .Cells(i, n + 8).Value = IIf(UBound(fData) > 0, "ok", "-")
            Next i
        Next n
    End With
 End Sub

（ろっくん） 2020/01/17(金) 09:24

Sub test3()

    Dim c As Range
    Worksheets("test").Range("G:G").ClearContents
    For Each c In Worksheets("test").Range("E:F").SpecialCells(2)
        If Not c.Offset(, -4).EntireColumn.Find(c.Value) Is Nothing Then
            Worksheets("test").Cells(c.Row, 7).Value = Cells(c.Row, 7).Value & Left(c.Address(0, 0), 1) & "列oK"
        End If
    Next c
End Sub
（mm） 2020/01/17(金) 10:14

ろっくん様
ありがとうございます。

検証してみましたが

.Cells(i, n + 8).Value = IIf(UBound(fData) > 0, "ok", "-") ここの処理でうまくいかず、実際にはデータがあるのでOKのはずが-になってしまって
分かりませんでした。

（天） 2020/01/17(金) 22:20

 こんばんは！

 方法は色々あると思いますし、、データの取得方法にもよると思いますが、
私だったら、、データを一括で取得して、、
A列のE列、G列とかB列のF列、H列とある程度の規則性があるのなら

 ループの外でデータを一括で取得してループを抜けた後に一括で出力する

 読み込んで、またループして、、と面倒に思われるかもしれませんが、、
 要は、セルへのアクセスする回数を減らすことだと思います。

 今回の例では、、1回です。

 でも、、今回の様なやり方は本当は早くないです。
出力する配列は別に用意した方が早いです。

 その辺は、お勉強していただくとして、、
あるか？ないか？だけなら定番ですけど、ディクショナリーがいいと思います。

 まぁ、、何かの参考にでもなれば幸いです。

 では、、では、、

 Option Explicit
Sub てすと()
Dim MyDic As Object
Dim MyA As Variant
Dim i As Long
Dim n As Long
Set MyDic = CreateObject("Scripting.Dictionary")
With Worksheets("test")
    MyA = .Range("A1").CurrentRegion.Resize(, 8).Value
    For n = 0 To 1
        For i = LBound(MyA, 1) To UBound(MyA, 1)
            MyDic(MyA(i, 1 + n)) = Empty
        Next
        For i = LBound(MyA, 1) To UBound(MyA, 1)
            If MyDic.Exists(MyA(i, 5 + n)) Then MyA(i, 7 + n) = "Ok"
        Next
        MyDic.RemoveAll
    Next
    .Range("A1").Resize(UBound(MyA, 1), UBound(MyA, 2)).Value = MyA
End With
Set MyDic = Nothing
Erase MyA
End Sub
（SoulMan） 2020/01/17(金) 22:29

 衝突しました。

 お邪魔してましたら、、ごめんなさいです。。m(__)m
（SoulMan） 2020/01/17(金) 22:31

　＞4万件データがありかなり遅いのでもっと早い処理があれば

CountIfが遅いんですかねぇ。。。
体感でもいいので何秒とか何分とか教えてください。
あと、データはどのような物でしょうか？
数値？文字列？
あと、検索するセル範囲で値の並び替えは可能でしょうか？

Sub test2()

    Dim Rng1 As Range
    Dim Rng2 As Range
    Const myFormula As String = "=IF(COUNTIF(XXXX,E1),""OK"",NA())"

    Application.Calculation = xlCalculationManual

    Set Rng1 = ActiveSheet.Range("A1").CurrentRegion.Columns(1)
    Set Rng2 = ActiveSheet.Range("E1").CurrentRegion
    Set Rng2 = Rng2.Offset(, Rng2.Columns.Count)

    With Rng2
        .Formula = Replace(myFormula, "XXXX", Rng1.Address(True, False))
        .SpecialCells(xlCellTypeFormulas, xlErrors).ClearContents
        .Copy
        .PasteSpecial xlPasteValues
    End With

    Application.Calculation = xlCalculationAutomatic
End Sub

関係ないかも知れないけど、
再計算を一旦止めてみるのと、
コピペ使って値に変えるとか(遅くなるかも）、
やってみたらどうなるのでしょうか？

（まっつわん） 2020/01/17(金) 23:45

SoulMan様　まっつわん様

ありがとうございます。
（天） 2020/01/18(土) 11:36

コメント返信：

[ 一覧(最新更新順) ]

[[20200116224022]] 『VBA countifによる処理』（天） ページの最後に飛ぶ

[[20200116224022]]　『VBA countifによる処理』（天）　ページの最後に飛ぶ