VBA script vergelijken

[moensk]

ik wil een overzicht lijst van alle spelers hebben wanneer ik de datum ingeef.
ik heb 3 tabbladen
in bijlage klein voorbeeld om dit te illustreren

Bekijk bijlage script.xlsx

 

[lam201]

Hi,


dat kan zo.
Voorwaarde is wel dat er geen dubbele namen voorkomen.

groet,

Bekijk bijlage script2.xlsx

 

[moensk]

thanks is wel geen VB script maar zo kan het ook

 

[HSV]

Met Vba.

Sub hsv()
Dim sv, arr, i, ii, hs
sv = Sheets("namen").Range("a4:a8")
arr = Sheets("act").Range("a3:b5")
hs = Split(Join([transpose(row(1:5))]))
  For i = 1 To UBound(sv)
     For ii = 1 To UBound(arr)
        If arr(ii, 1) = sv(i, 1) And arr(ii, 2) = [info!b1] Then hs = Filter(hs, i, 0)
     Next ii
  Next i
 Sheets("info").Cells(1, 10).Resize(UBound(hs) + 1) = Application.Transpose(Application.Index(sv, hs, 0))
End Sub

Of:

Sub hsv()
Dim sv, arr, i, ii, hs
sv = Sheets("namen").Range("a4:a8")
arr = Sheets("act").Range("a3:b5")
hs = Split(Join(Application.Transpose(sv)))
 For i = 1 To UBound(sv)
    For ii = 1 To UBound(arr)
     If arr(ii, 1) = sv(i, 1) And arr(ii, 2) = [info!b1] Then hs = Filter(hs, arr(ii, 1), 0)
    Next ii
 Next i
Sheets("info").Cells(1, 10).Resize(UBound(hs) + 1) = Application.Transpose(hs)
End Sub

 

[VenA]

Als code in de bladmodule van het blad 'info'

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Target.Address = "$B$1" Then Exit Sub
    ar = Sheets("Namen").Cells(3, 1).CurrentRegion
    ar1 = Sheets("act").Cells(2, 1).CurrentRegion
    For j = 2 To UBound(ar)
      For jj = 2 To UBound(ar1)
        If LCase(ar(j, 1)) = LCase(ar1(jj, 1)) And ar1(jj, 2) = Target.Value Then Exit For
      Next jj
      If jj > UBound(ar1) Then c00 = c00 & "|" & ar(j, 1)
    Next j
    Cells(5, 1).Resize(UBound(ar)).ClearContents
    ar3 = Split(Mid(c00, 2), "|")
    Cells(5, 1).Resize(UBound(ar3) + 1) = Application.Transpose(ar3)
End Sub

 

[moensk]

VenA

werkt super alleen nog kort vraagje
ik wil het laten uitvoeren na drukken op knop
heb dit in knop geplakt maar dat werkt niet, graag nog even u hulp

 

[VenA]

De code in #4 is gemaakt voor een druk op de knop.

 

[HSV]

De bekende lengte!

 

[moensk]

code in #4 had ik al getest en die klopt niet
personen in act met juiste datum worden toch getoond na vergelijk

 

[HSV]

Wil ik wel eens zien aan de hand van je voorbeeldbestand.

 

[moensk]

in bijlage bestand, naam Joop zou niet mogen getoond zijn

Bekijk bijlage script_besch.xlsm

 

[HSV]

Joop <> joop

Verander....

If arr(ii, 1) = sv(i, 1) And arr(ii, 2) = [info!b1] Then hs = Filter(hs, arr(ii, 1), 0)

...in.

If LCase(arr(ii, 1)) = LCase(sv(i, 1)) And arr(ii, 2) = [info!b1] Then hs = Filter(hs, sv(i, 1), 0)

de gehele aangepaste code.

Sub beschikbaar()
Dim sv, arr, i, ii, hs
sv = Sheets("namen").Range("a4:a8")
arr = Sheets("act").Range("a3:b5")
hs = Split(Join(Application.Transpose(sv)))
 For i = 1 To UBound(sv)
    For ii = 1 To UBound(arr)
     If LCase(arr(ii, 1)) = LCase(sv(i, 1)) And arr(ii, 2) = [info!b1] Then hs = Filter(hs, sv(i, 1), 0)
    Next ii
 Next i
 With Sheets("info").Cells(1, 10)
 .CurrentRegion.ClearContents
 .Resize(UBound(hs) + 1) = Application.Transpose(hs)
 End With
End Sub

 

[moensk]

super bedankt !

 

[VenA]

Was ook hier te vinden.

 If LCase(ar(j, 1)) = LCase(ar1(jj, 1)) And ar1(jj, 2) = Target.Value Then Exit For

 

[HSV]

Dan moet je wel weten dat je arr(ii,1) moet veranderen in sv( i,1).

 

[moensk]

het script werkt in het voorbeeld doch ik wou het ook in origineel verwerken en dan krijg ik volgende foutmelding bij laatste regel "sheets ...."

 

[HSV]

if ubound(hs) > -1 then .Resize(UBound(hs) + 1) = Application.Transpose(hs)

 

[moensk]

Harry,
waar moet ik dit dan tussen voegen ?

 

[HSV]

Dit.....

[COLOR=#ff0000]if ubound(hs) > -1 then[/COLOR]

.......voor!

.Resize(UBound(hs) + 1) = Application.Transpose(hs)