Comparer une plage à un tableau
Le
Apitos

Bonsoir à tous,
J'aimerais comparer une plage à un tableau Tbl.
Je voulais utiliser la fonction InArray, mais ça ne marche pas :
[CODE]if cel.Value inarray(tbl) then range("F" & Cel.Row).Value="#" & Str=
date & "#"[/CODE]
Alors j'ai ajouté quelques lignes de codes en plus, pour remplacer le tra=
vail de cette fonction
Sub Comparer()
Dim WS1 As Worksheet, WS2 As Worksheet
Dim i As Long, j As Long
Dim Tbl() As String, Strg As String, Strdate As String
Dim C As Range, Cel As Range
Set WS1 = Sheets("feuil1")
Set WS2 = Sheets("feuil2")
Strdate = Format(Now, "dd/mm/yy")
'-- Remplir le tableau Tbl par les valeurs de la colonne A correspondan=
te
i = 1
For Each C In WS2.Range("F2:F" & WS2.[F65000].End(xlUp).Row)
If C.Value = "Done" Then
ReDim Preserve Tbl(i)
Tbl(i) = WS2.Range("A" & C.Row)
i = i + 1
End If
Next C
'-- Regrouper les valeurs du Tbl dans la chaine Strg pour faciliter la =
comparaison avec InStr
For j = 1 To UBound(Tbl)
Strg = Strg & Tbl(j) & "|"
Next j
'-- S'il y a une valeur de la colonne A feuille 1 qui corresponde à u=
ne valeur de Tbl
'-- On écrit la date d'aujourd'hui dans la colonne F
For Each Cel In WS1.Range("A2:A" & [A65000].End(xlUp).Row)
'if cel.Value inarray(tbl) then range("F" & Cel.Row).Value="#" & =
Strdate & "#"
If InStr(Strg, Cel.Value) = 1 Then
Range("F" & Cel.Row).Value = "#" & Strdate & "#"
End If
Next Cel
End Sub
1 - Existe-t-il une fonction similaire pour comparer une valeur à toutes =
les valeurs d'un tableau en une seule fois ?
2 - Si mon tableau Tbl comporte 4 valeurs, la dernière boucle du code ne =
considère la comparaison juste avec Instr que pour la première valeur s=
eulement !
3 - Sinon comment réduire ces lignes de codes ?
Merci d'avance.
J'aimerais comparer une plage à un tableau Tbl.
Je voulais utiliser la fonction InArray, mais ça ne marche pas :
[CODE]if cel.Value inarray(tbl) then range("F" & Cel.Row).Value="#" & Str=
date & "#"[/CODE]
Alors j'ai ajouté quelques lignes de codes en plus, pour remplacer le tra=
vail de cette fonction
Sub Comparer()
Dim WS1 As Worksheet, WS2 As Worksheet
Dim i As Long, j As Long
Dim Tbl() As String, Strg As String, Strdate As String
Dim C As Range, Cel As Range
Set WS1 = Sheets("feuil1")
Set WS2 = Sheets("feuil2")
Strdate = Format(Now, "dd/mm/yy")
'-- Remplir le tableau Tbl par les valeurs de la colonne A correspondan=
te
i = 1
For Each C In WS2.Range("F2:F" & WS2.[F65000].End(xlUp).Row)
If C.Value = "Done" Then
ReDim Preserve Tbl(i)
Tbl(i) = WS2.Range("A" & C.Row)
i = i + 1
End If
Next C
'-- Regrouper les valeurs du Tbl dans la chaine Strg pour faciliter la =
comparaison avec InStr
For j = 1 To UBound(Tbl)
Strg = Strg & Tbl(j) & "|"
Next j
'-- S'il y a une valeur de la colonne A feuille 1 qui corresponde à u=
ne valeur de Tbl
'-- On écrit la date d'aujourd'hui dans la colonne F
For Each Cel In WS1.Range("A2:A" & [A65000].End(xlUp).Row)
'if cel.Value inarray(tbl) then range("F" & Cel.Row).Value="#" & =
Strdate & "#"
If InStr(Strg, Cel.Value) = 1 Then
Range("F" & Cel.Row).Value = "#" & Strdate & "#"
End If
Next Cel
End Sub
1 - Existe-t-il une fonction similaire pour comparer une valeur à toutes =
les valeurs d'un tableau en une seule fois ?
2 - Si mon tableau Tbl comporte 4 valeurs, la dernière boucle du code ne =
considère la comparaison juste avec Instr que pour la première valeur s=
eulement !
3 - Sinon comment réduire ces lignes de codes ?
Merci d'avance.
| inarray(tbl)
Pour rechercher une valeur dans un "Array" (tableau), tu utilises la fonction "Match"
(Equiv())
X = application.Match(cel.Value,Tbl,0)
if IsNumeric(x) then
'X représente la position de la valeur dans le tableau
'La fonction Match s'arrête dès qu'elle trouve la première occurrence de la valeur
cherchée.
end if
Un petit exemple :
'-----------------------------------------
Sub test()
Dim InArray(), X As Variant
InArray = Array(5, 10, 25)
X = Application.Match(12, InArray, 0)
If IsNumeric(X) Then
MsgBox X
Else
Err = 0
End If
End Sub
'-----------------------------------------
MichD
---------------------------------------------------------------
En voulant adapter ton code avec le mien, j'ai reçu cette erreur :
'------------
Dim Tbl() As Long, X as Variant
X = Application.Match(Cel.Value, Tbl, 0)
'-------------
Erreur d'exécution '5':
Argument ou appel de procédure incorrect
Quel est le type de donnée que représente "cel.value" ? Valeur numérique, texte ?
Quel est le type de données contenues dans la variable tableau "Tbl" ? Valeur numérique,
texte?
Il doit y avoir concordance dans le type des données et du tableau pour que la fonction
"Match" fonctionne.
Au besoin, tu peux utiliser l'une des fonctions de conversion...
Cstr(), Clng() , Cdbl() .... voir l'aide VBA - Excel
MichD
---------------------------------------------------------------
Numérique
Numérique
données? Quelle est ta version d'Excel?
'-----------------------------------------
Sub test()
Dim InArray(), X As Variant
InArray = Array(5, 10, 25)
X = Application.Match(12, InArray, 0)
If IsNumeric(X) Then
MsgBox X
Else
Err = 0
End If
End Sub
'-----------------------------------------
MichD
---------------------------------------------------------------
voila l'exemple que j'utilise :
http://cjoint.com/?BDCaGWXmq9d
j'espere qu'on peut paufiner ce code ?
cette formule et la recopier sur toute la colonne.
'La plage de cellules Feuil1!A2:A11 peut être défini par un nom utilisant la fonction
Decaler()
'tu substitues dans la formule la plage par le nom.
'Tu mets la colonne avec un format date de ton choix.
=IF(ISNUMBER(INDEX(Feuil1!A2:A11;MATCH(IF(Feuil2!F2="done";A2;"");Feuil1!A2:A11;0)));TODAY();"")
Tu peux utiliser VBA pour copier la formule sur l'étendue de la plage de cellules...
et pour enlever la formule et mettre en dur la date
En supposant que tu veuilles tes dates en colonne B:B
Range("B2:B" & x).value = range("B2:B" & x) .value
MichD
---------------------------------------------------------------
"Apitos" a écrit dans le message de groupe de discussion :
ca marche maintenant..
voila l'exemple que j'utilise :
http://cjoint.com/?BDCaGWXmq9d
j'espere qu'on peut paufiner ce code ?
bouton de commande de la feuil1.
'----------------------------------------------------
Sub test()
Application.ScreenUpdating = False
Application.EnableEvents = False
With Feuil1
With .Range("A2:A" & .Range("A65536").End(xlUp).Row)
.Offset(, 1).Formula = "=IF(ISNUMBER(INDEX(" & _
"Feuil1!A2:A11,MATCH(IF(Feuil2!F2=" & _
"""done"",A2,""""),Feuil1!A2:A11,0))),TODAY(),"""")"
.Offset(, 1).Value = .Offset(, 1).Value
.Offset(, 1).NumberFormat = "dd/mm/yy"
End With
End With
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
'----------------------------------------------------
MichD
---------------------------------------------------------------
'-------------------------------------------
Sub test1()
Dim Rg As Range
Application.ScreenUpdating = False
Application.EnableEvents = False
With Feuil2
Set Rg = .Range("A2:A" & .Range("A65536").End(xlUp).Row)
End With
With Feuil1
With .Range("A2:A" & .Range("A65536").End(xlUp).Row)
.Offset(, 1).Formula = "=IF(ISNUMBER(INDEX(" _
& Rg.Parent.Name & "!" & Rg.Address & _
",MATCH(IF(" & Rg.Parent.Name & "!" & _
Rg(1).Offset(, 5).Address(0, 0) & _
"=""done"",A2,"""")," & .Address & ",0))),TODAY(),"""")"
.Offset(, 1).Value = .Offset(, 1).Value
.Offset(, 1).NumberFormat = "dd/mm/yy"
End With
End With
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
'-------------------------------------------
MichD
---------------------------------------------------------------
Ca marche parfaitement.
Merci bien.
Cordialment.