Formule VBA avec "OR" utlisant une liste dans excel

eric57

XLDnaute Junior
Bonjour le forum

J'ai une formule en VBA pour effectuer un tri.

MA formule est la suivante
Code:
 Range("C1:C50".FormulaR1C1 = "=IF(or(LEFT(RC[-2],2)=" & Sheets("correction").Range("O1") & ",LEFT(RC[-2],2)=" & Sheets("correction").Range("O2") & ",LEFT(RC[-2],2)=" & Sheets("correction").Range("O3") & ",LEFT(RC[-2],2)=" & Sheets("correction").Range("O4") & "),0,""z"")"
Comment faire pour pouvoir avoir une liste dynamique en Colonne "O" sans devoir ajouter à chaque fois la nouvelle cellule dans ma formule ?

Je pense certainement à une histoire de boucle, mais cela dépasse mes petites compétences.

Merci d'avance à ceux qui souhaiteraient m'aider.
 
Dernière édition:

Staple1600

XLDnaute Barbatruc
Bonsoir le fil, le forum, eric57

@eric57
mais cela dépasse mes petites compétences.
Petite ou grosse... compétence
Aucune ne t'empêche de joindre un fichier Excel qui facilitera la résolution rapide de ta question.
(En effet, on ne perdra pas de temps à recréer un classeur qui existe déjà sur ton disque dur)
 

Dranreb

XLDnaute Barbatruc
Bonsoir.
Et ça, ça n'irait pas ? :
VB:
Range("C1:C50").FormulaR1C1 = "=IF(ISNUMBER(MATCH(LEFT(RC1,2),correction!R1C15:R4C15,0)),0,""z"")"
Ou même ça :
VB:
Range("C1:C50").FormulaR1C1 = "=IF(ISNUMBER(MATCH(LEFT(RC1,2),correction!R1C15:R" _
   & Sheets("correction").Range("O10000").End(xlUp).Row & "C15,0)),0,""z"")"
 
Dernière édition:

eric57

XLDnaute Junior
Merci pour vos réponses.

Effectivement Staple1600 tu as raison, alors j'ai fait un fichier qui reprend ma macro au complet.

Le but est le suivant :

J'ai au départ une liste complète ( j'ai mis un exemple sur le feuil 3) qu'il faut trier pour ne conserver que les lignes dans la colonne A contient les 2 premières données de ma liste ( en feuil 2 colonne A) Cette liste devant être dynamique car on doit pouvoir ajouter des nouvelles données.

Dans l'exemple de ce fichier, a la fin je ne dois avoir plus que 490 lignes avec des codes qui commencent par 85 et par AQ

Peut-être que ma macro est une usine a gaz ? Et qu'une solution plus simple existe?

Cordialement
 

Fichiers joints

Dranreb

XLDnaute Barbatruc
Bonjour.
Il n'y aen colonne A aucune cellule contenant un texte commençant par les chiffres "85"
Mais s'il y en avait ma proposition marcherait :
VB:
Range("C1").Resize(dl_A).FormulaR1C1 = "=IF(ISNUMBER(MATCH(LEFT(RC1,2),Feuil2!R1C15:R" _
   & Sheets("Feuil2").Range("O10000").End(xlUp).Row & "C15,0)),0,""z"")"
 

eric57

XLDnaute Junior
Merci pour ton retour Dranreb

Tu me dis : " Il n'y a en colonne A aucune cellule contenant un texte commençant par les chiffres "85" " Cela m’étonne car il devrait en avoir au moins 486 dans mon exemple ?

Je vais en tout cas tester déjà ta formule , et je reviendrais te dire ce que cela donne .
 

Dranreb

XLDnaute Barbatruc
En fait celle ci semble marcher dans votre classeur joint même avec des produits par une puissance de 10 de nombres de 85 à 86 exclu, à condition d'enlever les doubles guillemets dans la Feuil2 et de mettre une apostrophe simple devant les contenus pouvant être interprétés comme des nombres au lieu de textes.
VB:
Range("C1").Resize(dl_A).FormulaR1C1 = "=IF(ISNUMBER(MATCH(LEFT(RC1,2),Feuil2!R1C1:R" _
   & Sheets("Feuil2").Range("A10000").End(xlUp).Row & "C1,0)),0,""z"")"
Stop
 

Staple1600

XLDnaute Barbatruc
Bonsoir le fil, le forum, eric57, Dranreb

@eric57
Aprés avoir ouvert ta PJ et aprés avoir lue ta macro présente en feuille 1, je me permets de te proposer un équivalent
(à peaufiner) un chouia plus court ;)
(A mettre dans un module standard)
VB:
Sub Test_TrieBIS()
Dim dl& 'variable
'dernière ligne non vide colonne A
dl = Cells(Rows.Count, 1).End(xlUp).Row
'tri
Range("A1:B" & dl).Sort Key1:=Range("A:B"), Header:=1, Order1:=1
With Cells(2, 3).Resize(dl - 1)
.Formula = "=LEFT(A2,2)": .Value = .Value 'formule en colonne C
.Offset(, 1).Formula = "=2-ISNUMBER(MATCH(C2,Feuil5!$A$1:$A$4,0))" 'formule en colonne D
End With
End Sub
NB: Ici, en colonne D => 1= OK et 2 = Pas OK
 
Dernière édition:

eric57

XLDnaute Junior
Bonjour Staple1600

Non je suis désolé, mais ta formule ne convient pas .

Elle conserve la 1ere ligne, et de plus ma liste en feuille 2 ( ou 5 dans ta formule) doit être dynamique, puisque je serais appelè a ajouter des nouvelles références

Merci quand même pour ton implication
 

Staple1600

XLDnaute Barbatruc
Bonjour le fil, le forum

@eric57
C'était pourtant écrit dedans ;)
je me permets de te proposer un équivalent
(à peaufiner) un chouia plus court
Pour ce qui d'avoir une liste dynamique, ce n'est pas les exemples qui manquent sur le forum
Mon propos était juste de te proposer un code VBA un peu plus court que le tien
Et c'est le cas, non ? :D
VB:
Sub Trie_()


Dim dlAD As Long, dlAR As Long, dlBC As Long, cell_vide As Long, C1 As Integer


Dim dl_A As Long ' nombre total de cellules dans la colonne A

' C1 donne le nombre de cellules en A qui commencent par bien par les 2 premiers données en liste feuil 2 Colonne A

' Je vide les colonnes pour ne pas avoir des restes d'anciens imports et ne conserver que mes 2 colonnes a traiter

Sheets("Feuil1").Columns("c:bd") = Empty




'On supprime les = et les espaces

Sheets("Feuil1").Range("a:b").Replace What:="=", Replacement:="", LookAt:= _
xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Sheets("Feuil1").Range("a:b").Replace What:=" ", Replacement:="", LookAt:= _
xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

' Application.ScreenUpdating = False ' je desactive l'affichage pour gagner du temps


'On convertit la colonne A pour separer les données si des espaces sont présent
Sheets("Feuil1").Select
Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), _
        TrailingMinusNumbers:=True
        

'on trie avant la copie pour gagner du temps

Sheets("Feuil1").Columns("a:b").Select
    Range("a1").Activate
    Application.CutCopyMode = False
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range( _
        "a1:a31170"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("Feuil1").Sort
        .SetRange Range("a1:b31170")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveSheet.Range("$a$1:$b$31170").RemoveDuplicates Columns:=1, Header:= _
        xlNo
        
' ici je trie les données dont les 2 premières lettres ne sont pas dans ma liste en A1 sur feuil 2

 dl_A = Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row
 
 Range("C1:C" & dl_A).FormulaR1C1 = "=IF(or(LEFT(RC[-2],2)=" & Sheets("Feuil2").Range("A1") & ",LEFT(RC[-2],2)=" & Sheets("Feuil2").Range("A2") & ",LEFT(RC[-2],2)=" & Sheets("Feuil2").Range("A3") & ",LEFT(RC[-2],2)=" & Sheets("Feuil2").Range("A4") & "),""OK"",""Pas Ok"")"
 
  Range("c1:c" & dl_A).Select
    Selection.Copy
     Range("C1").Select
    Selection.AutoFill Destination:=Range("C1:C" & dl_A), Type:=xlFillDefault
    Range("C1:C" & dl_A).Select
    Columns("A:C").Select
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range( _
        "C1:C" & dl_A), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Feuil1").Sort
        .SetRange Range("A1:C" & dl_A)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    
    Columns("c:c").Select
    Selection.Copy
    Range("c1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

C1 = WorksheetFunction.CountIf(Sheets("Feuil1").Columns("C"), "OK")

MsgBox C1
        
 
If C1 <> dl_A Then
Range("a" & C1 + 1 & ":c" & dl_A + 1) = Empty
End If
 
'je met juste le nombre de cellule en msgbox pour verifier le calcul

End Sub
 
Dernière édition:

eric57

XLDnaute Junior
ok

Je ne vois pas ce que tu veux dire par " C’était pourtant écrit dedans"

et ma demande initiale était bien pour utiliser une liste dynamique dans ma formule.

donc meme plus court, je n'arrive pas ou ne sais pas utiliser ton code

Cordialement
 

Staple1600

XLDnaute Barbatruc
Re

Bah: "à peaufiner" , ça veut bien dire ce que ça veut dire, non ? ;)
Et c'était bien écrit dans le message#9
(je voulais dire par là, que ma macro est une première version et qu'elle doit/peut être peaufiner)

Ôte-moi d'un doute: le code VBA présent dans la feuille de ta pièce jointe est bien de toi ?
 

Staple1600

XLDnaute Barbatruc
Re

Donc une version modifiée pour prendre en compte l'ajout de données dans la liste en Feuil5
VB:
Sub Test_TrieTER()
Dim dl&, Liste As Range 'variable
'dernière ligne non vide colonne A
Set Liste = Feuil5.Cells(1, 1).Resize(Feuil5.Cells(Rows.Count, 1).End(3).Row)
dl = Cells(Rows.Count, 1).End(xlUp).Row
'tri
Range("A1:B" & dl).Sort Key1:=Range("A:B"), Header:=1, Order1:=1
With Cells(2, 3).Resize(dl - 1)
.Formula = "=LEFT(A2,2)": .Value = .Value 'formule en colonne C
.Offset(, 1).Formula = "=2-ISNUMBER(MATCH(C2,Feuil5!" & Liste.Address & ",0))" 'formule en colonne D
End With
End Sub
 

Discussions similaires


Haut Bas