Adresse d'une valeur dans une MsgBox

[BChaly]

Bonsoir à tous,

Le code suivant fonctionne très bien pour trouver l'adresse d'une valeur dans une MsgBox.

Comment puis-je modifier ce code pour supprimer l'adresse des cellules vides?
(Supprimer la 1ere ligne du message dans mon exemple)

Merci pour votre aide.

Cordialement,

BChaly

Option Explicit

Sub AdresseValeur()
 
Dim D1, D2 As Object
Dim V1, V2 As Variant
Dim K1 As Variant
Dim Rge As Range
Dim i As Integer
Dim No, Address As String
 
Set D1 = CreateObject("Scripting.Dictionary")
Set D2 = CreateObject("Scripting.Dictionary")
Set Rge = Range([B1], Range("B" & Rows.Count).End(xlUp))

    For i = 1 To Rge.Count
        No = Rge(i) & " " & Rge(i).Offset(0, 1)
                If D1.exists(No) = True Then
                D1.Add No, No
                    Else
            If D2.exists(No) = False Then
                D2.Add No, Rge(i).Address(0, 0)
                    Else
                D2(No) = D2(No) & "; " & Rge(i).Address(0, 0)
            End If
            End If
    Next i
   
V1 = D2.Items
K1 = D2.keys
     
    For i = 0 To D2.Count - 1
        V2 = V2 & K1(i) & " se trouve dans la cellule " & V1(i) & vbCrLf
    Next i
 
MsgBox V2
    
End Sub

 

[pierrejean]

Re : Adresse d'une valeur dans une MsgBox

Bonjour Bchaly

Teste:

......
    For i = 0 To D2.Count - 1  
       If K1(i) <> " " Then V2 = V2 & K1(i) & " se trouve dans la cellule " & V1(i) & vbCrLf
    Next i
......

 

[xhudi69]

Re : Adresse d'une valeur dans une MsgBox

Bonjour BChaly, le Forum,
Bonjour pierrejean

Ou alors ceci:

Sub AdresseValeur()
 
Dim D1, D2 As Object
Dim V1, V2 As Variant
Dim K1 As Variant
Dim Rge As Range
Dim i As Integer
Dim No, Address As String
 
Set D1 = CreateObject("Scripting.Dictionary")
Set D2 = CreateObject("Scripting.Dictionary")
Set Rge = Range([B1], Range("B" & Rows.Count).End(xlUp))

    For i = 1 To Rge.Count
        No = Rge(i) & " " & Rge(i).Offset(0, 1)
        If Rge(i) <> "" Then '=========================================
            If D1.exists(No) = True Then
                D1.Add No, No
                    Else
            If D2.exists(No) = False Then
                D2.Add No, Rge(i).Address(0, 0)
                    Else
                D2(No) = D2(No) & "; " & Rge(i).Address(0, 0)
            End If
            End If
        End If '========================================================
    Next i
   
V1 = D2.Items
K1 = D2.keys
    For i = 0 To D2.Count - 1
        V2 = V2 & K1(i) & " se trouve dans la cellule " & V1(i) & vbCrLf
    Next i
MsgBox V2
End Sub

@+

 

[BChaly]

Re : Adresse d'une valeur dans une MsgBox

Bonsoir pierrejean,
Bonsoir xhudi69,

Voici deux excellentes solutions qui fonctionnent parfaitement!!!

Merci à tous les deux pour votre aide.

Cordialement,

BChaly