VBA meerdere Application.CountIf

[ivoexcel]

Hallo allemaal,

Ik heb een bestand waarin onderstaande macro zit. De bedoeling is dat:

waarde in de regel kolom B gelijk is aan r7.value
waarde in de regel kolom D gelijk is aan r7.value
waarde in de regel kolom A gelijk is aan r4.value


als alle 3 de waardes in de regel en in het blad akkoord gelijk zijn aan elkaar dan moet er "ja"komen te staan.

In enkele gevallen gaat dit nu niet goed en komt er "ja" te staan terwijl niet alle waardes gelijk zijn aan elkaar. Hoe kan dit?

Ik heb geprobeerd een voorbeeld bestand te plaatsen helaas komt de fout dan niet voor....

Sub Refresh()

Application.ScreenUpdating = False

'zoekt in akkoord blad
Sheets("Data").Visible = True
Sheets("Data").Activate

Dim r1 As Range, r2 As Range, r3 As Range, r4 As Range, r5 As Range, r6 As Range, r7 As Range, r8 As Range, r9 As Range, r10 As Range

For I = 2 To Cells(Rows.Count, "C").End(xlUp).Row
Set r1 = Range("A" & I)
Set r2 = Range("B" & I)
Set r3 = Range("C" & I)
Set r4 = Range("E" & I)
Set r5 = Range("F" & I)
Set r6 = Range("G" & I)
Set r7 = Range("H" & I)
Set r8 = Range("I" & I)
Set r9 = Range("J" & I)
Set r10 = Range("AG" & I)

r10.Value = ""

If r1.Value <> "" And _
    Application.CountIf(Worksheets("Akkoord").Range("B:B"), r7.Value) And _
        Application.CountIf(Worksheets("Akkoord").Range("D:D"), r8.Value) And _
            Application.CountIf(Worksheets("Akkoord").Range("A:A"), r4.Value) Then
                    r10.Value = "Ja"
Else

If r1.Value = "" And _
    Application.CountIf(Worksheets("Akkoord").Range("B:B"), r7.Value) And _
        Application.CountIf(Worksheets("Akkoord").Range("E:E"), r9.Value) And _
            Application.CountIf(Worksheets("Akkoord").Range("A:A"), r4.Value) Then
                    r10.Value = "Ja"
Else
    r10.Value = "-"
End If
End If

Next I

Application.ScreenUpdating = True

MsgBox "De gegevens zijn bijgewerkt."

End Sub

 

[edmoor]

Kijk dan naar het verschil tussen je bestand met de fout en je voorbeeld bestand waarin de fout niet voor komt.

 

[ivoexcel]

Ja dat heb ik gedaan niks te vinden. Het gaat fout bij kolom D, R8 en kolom E, R9. Die waarde kom niet samen voor met de andere voorwaardes.

 

[edmoor]

Plaats dan je bestand met de fout.
Eventueel geanonimiseerd.

 

[snb]

Dit is voldoende:

Sub M_snb()
  sn= Sheets("Data").usedrange

  for j=2 to ubound(sn)
    sn(j,1)=format((sn(j,2)=sn(j,8))*(sn(j,4)=sn(j,8))*(sn(j,1)=sn(j,5)),"yes/no")
  next

  sheets("Data").cells(1,33).resize(ubound(sn))=sn
End Sub

Het werkblad hoeft niet zichtbaar te zijn (liever niet) en ook niet geselecteed (want overbodig).

 

[ivoexcel]

Sorry voor de wat late reactie. Hierbij het voorbeeld bestand.
De macro is gedraaid en in het blad "Totaal overzicht" staan in de draaitabel 5 bedragen die niet voorkomen in het het blad "akkoord" toch staat hier Ja bij. kan iemand mij vertellen wat hier mis gaat?

@SNB jou code werkt inderdaad een stuk sneller alleen wordt niet gekeken of de gegevens voorkomen in het blad "Akkoord" waardoor dus alles Nee wordt. Hoe kan ik aangeven dat de cellen gezocht moeten worden in het blad Akkoord?

Alvast bedankt.

 

[VenA]

Volgens mij klopt het bestand niet met de eerder geplaatste code. kolom A is leeg en dan zou ik nergens een ja verwachten. Om werkbladen te vergelijken kan het bv zo.

Sub VenA()
  ar = Sheets("Akkoord").Cells(1).CurrentRegion
  ar1 = Sheets("Data").Cells(1).CurrentRegion.Resize(, 34)
  
  With CreateObject("Scripting.Dictionary")
    For j = 2 To UBound(ar)
      .Add ar(j, 1) & "|" & ar(j, 2) & "|" & ar(j, 4), ""
    Next j
    For j = 2 To UBound(ar1)
      ar1(j, 34) = .exists(ar1(j, 5) & "|" & ar1(j, 8) & "|" & IIf(ar1(j, 9) = "", ar1(j, 10), ar1(j, 9)))
    Next j
  End With
  
  Sheets("data").Cells(1).CurrentRegion.Resize(, 34) = ar1
End Sub

 

[ivoexcel]

Inderdaad heb alles in A leeggemaakt. mijn fout.

Hierbij de aanpassing.

Bovenstaande code geeft ook "waar" bij regels waar dit niet moet.

 

[VenA]

Waarom is in het voorbeeld in de tab data de 2e rij niet akkoord? Dezelfde gegevens staan toch in de 2e rij van blad Akkoord

 

[ivoexcel]

Dat mij ook een raadsel...

Jou code werkt prima alleen krijg ik na het vernieuwen van alle data de volgende foutmelding:

Bekijk bijlage 359213

Bekijk bijlage 359214

 

[VenA]

de bijlagen zijn niet te openen.

 

[ivoexcel]

Dat is raar bij mij wel zijn gewoon afbeeldingen.

er staat: Fout 6 tijdens uitvoering: Overloop

Vervolgens wordt regel 2 geel dat is deze: ar1 = Sheets("Data").Cells(1).CurrentRegion.Resize(, 34)

 

[VenA]

Plaats het bestand met de code even.

 

[ivoexcel]

Hierbij het bestand met de foutmelding

 

[VenA]

Je hebt kolom Q opgemaakt als datum. Dit geeft in sommige gevallen een foutwaarde. (Zie bv Q1493)

Maak er eens dit van:

ar = Sheets("Akkoord").Cells(1).CurrentRegion.Value2
  ar1 = Sheets("Data").Cells(1).CurrentRegion.Value2

 

[ivoexcel]

ow kijk dankjewel! ik kan weer even vooruit.

Nu komt er Waar en onwaar te staan. Hoe kan ik dat weer aanpassen naar Ja en - bijvoorbeeld?

 

[VenA]

Daar is IF THEN ELSE of IIF voor uitgevonden.

ar1(j, 33) = IIf(ar1(j, 1) <> "" And .exists(ar1(j, 5) & "|" & ar1(j, 8) & "|" & IIf(ar1(j, 9) = "", ar1(j, 10), ar1(j, 9))), "Ja", "-")

 

[ivoexcel]

Goed punt...


Nu wordt de code gedraaid als A niet leeg is. Zoals bij de eerste code kan A ook leeg zijn. Dan moet kolom J (10) in Data vergeleken worden met kolom E (5). Dat stuk ontbreekt nu. Hoe kan ik dat toevoegen zonder de hele code te herhalen?

 

[VenA]

En als je dit stukje weglaat?

ar1(j, 1) <> "" And

 

[ivoexcel]

als in kolom 1 iets staan dan moet:

With CreateObject("Scripting.Dictionary")
    For j = 2 To UBound(ar)
      .Add ar(j, 1) & "|" & ar(j, 2) & "|" & ar(j, 4), ""
    Next j
    For j = 2 To UBound(ar1)
      ar1(j, 33) = IIf(ar1(j, 1) <> "" And .exists(ar1(j, 5) & "|" & ar1(j, 8) & "|" & IIf(ar1(j, 9) = "", ar1(j, 10), ar1(j, 9))), "Ja", "Nee")
    Next j
  End With

als er niks staat wordt het:

  With CreateObject("Scripting.Dictionary")
    For j = 2 To UBound(ar)
      .Add ar(j, 1) & "|" & ar(j, 2) & "|" & ar(j, 5), ""
    Next j
    For j = 2 To UBound(ar1)
      ar1(j, 33) = IIf(ar1(j, 1) = "" And .exists(ar1(j, 5) & "|" & ar1(j, 8) & "|" & IIf(ar1(j, 10) = "", ar1(j, 10), ar1(j, 10))), "Ja", "Nee")
    Next j
  End With