Code vba RechercheMultiple (Fonction InStr) [Résolu/Fermé]

Signaler
-
Messages postés
16315
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
30 novembre 2020
-
Bonjour à tous,

Voici mon code vba ci-dessous, le problème est qu'il detecte seulement la première chaine de caractère càd "Blayais" pas les 4 autres.

Sub SitesSDIN()

nomcible = ActiveWorkbook.Name

Workbooks(nomcible).Sheets("Feuille1").Select
Set f2 = Sheets("Feuille1")
LastLine2 = f2.Cells(Columns(1).Cells.Count, 3).End(xlUp).Row

For lig = 3 To LastLine2

SiteSDIN = "Blayais, Dampierre, Gravelines, Nogent, Tricastin"

If InStr(SiteSDIN, f2.Range("A" & lig)) = 1 Then
f2.Range("H" & lig) = "Oui"'
Else
f2.Range("H" & lig) = "Non"
End If
Next lig

End Sub



Merci d'avancé et Bien Cordialement.

1 réponse

Messages postés
16315
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
30 novembre 2020
3 082
Bonjour

essaies
Option Explicit
'------------
Sub SitesSDIN()
Dim Lastline2 As Integer, Lig As Integer
Dim SiteSDIN, Cptr As Byte

Application.ScreenUpdating = False
SiteSDIN = Array("Blayais", "Dampierre", "Gravelines", "Nogent", "Tricastin")
With ActiveWorkbook.Sheets("Feuille1")
Lastline2 = Cells(Columns(1).Cells.Count, 3).End(xlUp).Row
For Lig = 3 To Lastline2
For Cptr = 0 To UBound(SiteSDIN)
If .Cells(Lig, "A") = SiteSDIN(Cptr) Then
.Cells(Lig, "H") = "oui"
Exit For
End If
Next Cptr
If .Cells(Lig, "H") = "" Then .Cells(Lig, "H") = "non"
Next Lig
.Activate
End With
End Sub

 Michel
Ré michel_m,

J'ai une demandé supplémentaire, exemple si mes données : SiteSDIN = Array("Blayais", "Dampierre", "Gravelines", "Nogent", "Tricastin")
étaient placées dans une feuille; par exemple colonne D:

D1 : Blayais
D2 : Dampierre
D3 : Gravelines
D4 : Nogent
D5 : Tricastin

Que ce qui va changer dans le code par j'ai une erreur au niveau de cette ligne : For Cptr = 0 To UBound(SiteSDIN)
Il ne voit pas le tableau et une chose mes lignes pourrait changer dans l'avenir donc il faudra une boucle : While xxx <> pour détecter les cellules non vides (Pour l'instant c'est que 5 lignes).
Merci d'avancé et Cordialement.
Messages postés
16315
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
30 novembre 2020
3 082
re,

la solution par liste dans la feuille est pour moi la meilleure
j'ai fait une petite maquette

dans la colonne D on peut ajouter ou enlever une centrale

dans la colonne A j'ai 2 sites non inscrits en col D

Sub ccc()
derlig = Columns("d").Find("*", , , , , xlPrevious).Row
Set villes = Range("D1:D" & derlig)
For Lig = 1 To 4
If Not IsError(Application.Match(Cells(Lig, "A"), villes, 0)) Then
MsgBox "gagné"
Else
MsgBox "perdu"
End If
Next
End Sub
>
Messages postés
16315
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
30 novembre 2020

Bonjour Michel_m?

Tu es génial, merci beaucoup encore un grand merci.

Impeccable!!!

Cordialement.
Ré Michel_m,

C'est encore moi, tu pourras jeter un oeil sur mon code ci-dessous:
Mes données sont :
A1 : A&K-CYCLADES-01.03
A2:EPSILON2
A3: ECLAT-01.00
A4: VisuSM-01.06
A5: Portail
A6: Portail-01.05
Je souhaite enlever le "-" et caractère numérique donc ce qui donne :
A1 : A&K-CYCLADES
A2:EPSILON2
A3: ECLAT
A4: VisuSM
A5: Portail
A6: Portail
En version formule ça donne : SIERREUR(GAUCHE(B111;TROUVE("-";B111;NBCAR(B111)-5)-1);B111))
Voici mon code actuel mais il ne fait pas ce que je souhaite obtenir:
ss = StrReverse(s)
' r = rang du "-" dans ss
r = InStr(1, ss, "-")

' si r non nul et égal à n et r = 6 alors
' si le caractère précédent le "-" dans ss est numérique alors
' s = s sans les n derniers caractères
If r <> 0 And r = n Then 'r <> 0 And r = n
If IsNumeric(Mid(ss, r - 1, 1)) Then
s = Left(s, Len(s) - n)
Else
s = s
End If
Merci d'avancé et Cdlmt.
Messages postés
16315
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
30 novembre 2020
3 082 > Tshims
re,

Tu peux créer une fonction insérée dans le code ou comme fonction personnalisée sur la feuille Excel à la place d'une formule
Option Explicit
'------
Function avant_tiret(Texto As String) As String
Dim Separe
Application.Volatile
If Len(Texto) > 0 Then
Separe = Split(Texto, "-")
avant_tiret = Trim(Separe(0))
Else
avant_tiret = ""
End If
End Function


Bon WE