XL 2013 Exporter sur un classeur les données d'une fenêtre MsgBox

[calypso17]

Bonjour à tous,

Je suis complètement novice en VBA et c'est pour cela que je sollicite votre aide!

J'utilise le petit programme suivant qui me permet de repérer les références des cellules contenant l'acronyme CR :

Sub trouverCR()

tableauAdresses = cellsSearch(Range("A1:CU224"), "CR")
arrayDebug tableauAdresses

End Sub

Mes références de cellules s'affichent alors dans une MsgBox mais je souhaiterais finalement visualiser ces références dans un tableau sur un classeur Excel. Savez-vous comment faire, est-ce possible?

Je vous remercie par avance!

 

[Dudu2]

Bonjour,
Mon Excel 2013 ne connaît ni cellsSearch ni arrayDebug !

 

[calypso17]

Bonjour,

J'ai ajouté ces nouvelles fonctions via ce site : https://www.excel-pratique.com/fr/fonctions-complementaires

 

[Dudu2]

Oui, j'ai vu ça sur Internet.
Si le retour de cellsSearch est un tableau dont le 1er indice est 0 comme laisse le supposer un screenshot du bidule

alors peut-être qu'une fonction comme celle-ci répondrait à ta question.

Sub trouverCR()
    Dim TableauAdresses() As Variant

    TableauAdresses = cellsSearch(Range("A1:CU224"), "CR")
    'arrayDebug TableauAdresses
    Call EnCellules(TableauAdresses, ActiveSheet.Range("A1"))

End Sub

Sub EnCellules(TableauAdresses() As Variant, Cellule As Range)
    Dim t() As Variant
    Dim i As Integer
    
    If Not (Not TableauAdresses) Then
        'Dimensionné
    Else
        'Pas dimensionné
        Exit Sub
    End If
    
    'Si TableauAdresses() commence en indice 0
    If LBound(TableauAdresses) = 0 Then
        ReDim t(1 To UBound(TableauAdresses) + 1)
        
        For i = LBound(TableauAdresses) To UBound(TableauAdresses)
            t(i + 1) = Trim(TableauAdresses(i))
        Next i
        
        Cellule.Resize(UBound(t), 1).Value = Application.Transpose(t)
    Else
        Cellule.Resize(UBound(TableauAdresses), 1).Value = Application.Transpose(TableauAdresses)
    End If
End Sub

 

[Dudu2]

Mais je ne suis pas sûr que ça fonctionne car EXCEL-PRATIQUE pratique l'art de l'imprécision:

La fonction VBA cellsSearch recherche une valeur dans une plage de cellules et renvoie (sous forme de tableau) la liste des adresses de toutes les cellules contenant la valeur recherchée.

Sub exemple()
    tableauAdresses = cellsSearch(Range("A1:E10"), 7)
    arrayDebug tableauAdresses 'Affichage du tableau dans une MsgBox pour vérification
End Sub

Donc non seulement ils ne déclarent pas leurs variables dans le code VBA, donc on ne connait pas le type de tableauAdresses (String, Variant, Range ?) mais en plus ils ne précisent pas non plus dans leur documentation quel type de variable la fonction retourne. Faut le faire !

 

[calypso17]

Effectivement j'obtiens bien une liste de référence commençant par [0] :

Merci beaucoup pour ton code, j'ai essayé de le rentrer mais une fenêtre m'indique "Incompatibilité de type", sais-tu d'où cela pourrait venir?

Merci beaucoup pour ton aide!

 

[calypso17]

Je confirme ce n'est pas très clair! Mais cette fonction me sauve la vie car c'est la seule à ma connaissance qui permet de trouver des caractères dans tout un tableau et pas seulement dans une ligne ou une colonne :/

 

[Dudu2]

S'il y a une erreur d'incompatibilité de type à l'appel de la fonction, utiliser cette version.
Sauf si TableauAdresses() est tableau de type Range !!!

Sub trouverCR()
    Dim TableauAdresses() As String

    TableauAdresses = cellsSearch(Range("A1:CU224"), "CR")
    Call EnCellules(TableauAdresses, ActiveSheet.Range("CV1"))

End Sub

Sub EnCellules(TableauAdresses() As String, Cellule As Range)
    Dim t() As Variant
    Dim i As Integer
    Dim k As Integer
 
    If Not (Not TableauAdresses) Then
        'Dimensionné
        'Résultat d'un Split sans valeurs ?
        If UBound(TableauAdresses) = -1 Then Exit Sub
    Else
        'Pas dimensionné
        Exit Sub
    End If

    If LBound(TableauAdresses) = 0 Then k = 1
    ReDim t(1 To UBound(TableauAdresses) + k)
     
    For i = LBound(TableauAdresses) To UBound(TableauAdresses)
        t(i + k) = Trim(TableauAdresses(i))
    Next i
 
    Cellule.Resize(UBound(t), 1).Value = Application.Transpose(t)
End Sub

 

[patricktoulon]

bonjour
perso j'utiliserais jamais un complément xlam sans pouvoir regarder le code qui y est écrit
a bon entendeur

 

[patricktoulon]

re
la fonction comme je la vois puisque l'on peut pas voir le code du xlam

Sub trouvertoto()
    Dim TableauAdresses
    TableauAdresses = cellsSearch(Range("A1:F20"), "toto", 0)
    MsgBox UBound(TableauAdresses) & " cellules trouvée(s)"
    MsgBox Join(TableauAdresses)
End Sub


'position = 0 = xlPart
'position = 1 = commence par
'position = 2 = termine par
Function cellsSearch(rng As Range, expression As String, Optional position As Long = 0)
    Dim T(), Q&, cel
    For Each cel In rng.Cells
        Select Case position
        Case 0: finding = InStr(cel.Value, expression) > 0
        Case 1: finding = Left(cel.Value, Len(expression)) = expression
        Case 2: finding = Right(cel.Value, Len(expression)) = expression
        End Select
        If finding = True Then Q = Q + 1: ReDim Preserve T(1 To Q): T(Q) = cel.Address
        finding = False
    Next
    If Q = 0 Then cellsSearch = Array(0) Else cellsSearch = T
End Function

 

[Dudu2]

Ah m... ! J'ai cliqué sur leur .xlam
Comment je fais pour m'en débarrasser ?

 

[patricktoulon]

re
bah... t 'ai pas obligé tu peux faire confiance

 

[Dudu2]

Oui, merci pour ton conseil !
Je vais tenter un point de restauration.

 

[patricktoulon]

mais non tu le decoche et le supprime dans le dossier des addins c'est tout

 

[Dudu2]

ok ok. Toutes façons je les trouve pas / plus dans les compléments. Après un retour sur Point de Restauration dans lesquels je ne sais pas si ce genre de truc est couvert.