Ajouter la ligne dans un Dictionary si Arr(i, 1) et non vide

bonjour

voici mon code dans le but d'Ajouter la ligne dans un Dictionnaire si Arr(i, 1) et non vide.

Sub Macro1()

Dim Arr()
Dim Dict As Object
Set Dict = CreateObject("Scripting.Dictionary")
Arr = Sheets("etatEncaissementNonIdentifier").Range("B1:L25669").Value

For i = LBound(Arr, 1) To UBound(Arr, 1)
    If Arr(i, 1) <> "" Then

        Dict(Arr(i)) = Dict(Arr(i, 1))

    End If
Next i

End Sub

sauf dans cette ligne ça marche pas

Dict(Arr(i)) = Dict(Arr(i, 1))

j'ai pas trouver la bonne expression pour ajouter dans le Dict les lignes non vides

merci

bonjour

une dictionnaire permet de stocker une clé et une information associée. S'il n'y a que la clé qui t'intéresse tu mets n'importe quoi comme valeur associée.

For i = LBound(Arr, 1) To UBound(Arr, 1)
    If Arr(i, 1) <> "" Then

        Dict(Arr(i,1)) = i

    End If
Next i

dans cet exemple on associe le numéro d'indice i à la clé trouvée en arr(i,1)

Bonjour Mr et merci pour votre réponse

ce qui m'intéresse c'est si la cellule B1 non vide je garde toute la ligne du tableau

voici un petit exemple.

Résultat

C'est a dire si la cellule Arr(i, 1) <> "" then

je ne prend pas toute la ligne

j'ai modifier le code mais ca marche pas

Sub Macro1()

Dim Arr(),Temp()
Arr = Sheets("etatEncaissementNonIdentifier").Range("B1:L25669").Value

For i = LBound(Arr, 1) To UBound(Arr, 1)
 If Arr(i, 1) <> "" Then
        For j = LBound(Arr, 2) To UBound(Arr, 2)
           Temp(i, j) = Arr(i, j)
        Next j
    End If   
Next i
Sheets("teste").Range("B1:L25669").Value = Arr
End Sub

Salut h2so4, iliess

essaye ces deux façons :

Sub Macro2()

Dim Arr, Tmps
Arr = Sheets("etatEncaissementNonIdentifier").Range("B1:L25669").Value

ReDim Tmps(UBound(Arr, 2) - 1, 0)
For i = LBound(Arr, 1) To UBound(Arr, 1)
 If Arr(i, 1) <> "" Then
        For j = LBound(Arr, 2) - 1 To UBound(Arr, 2) - 1
           ReDim Preserve Tmps(UBound(Arr, 2) - 1, m)
           Tmps(j, m) = Arr(i, j + 1)
        Next j
        m = m + 1
 End If
Next i
Sheets("teste").Range("B1").Resize(UBound(Tmps, 2) + 1, UBound(Tmps, 1) + 1) = Application.Transpose(Tmps)
End Sub

Et :

 
 Sub Macro3()

Dim Arr, Tmps
Set Etnsmt = Sheets("etatEncaissementNonIdentifier")
Arr = Etnsmt.Range("B1:L25669").Value
n = Application.CountIfs(Etnsmt.Range("B1:B9"), "<>" & "")
ReDim Tmps(n, UBound(Arr, 2) - 1)
For i = LBound(Arr, 1) To UBound(Arr, 1)
 If Arr(i, 1) <> "" Then
        For j = LBound(Arr, 2) - 1 To UBound(Arr, 2) - 1
           Tmps(m, j) = Arr(i, j + 1)
        Next j
        m = m + 1
 End If
Next i
Sheets("teste").Range("B1").Resize(UBound(Tmps, 1) + 1, UBound(Tmps, 2) + 1) = Tmps
End Sub

Mille Merci Beaucoup Mr AMIR

Macro2 fonctionne très bien.

Stp essaye a nouveau macro 3 :

Sub Macro3()

Dim Arr, Tmps
Set Etnsmt = Sheets("etatEncaissementNonIdentifier")
Arr = Etnsmt.Range("B1:L25669").Value
n = Application.CountIfs(Etnsmt.Range("B1:B25669"), "<>" & "")
ReDim Tmps(n, UBound(Arr, 2) - 1)
For i = LBound(Arr, 1) To UBound(Arr, 1)
 If Arr(i, 1) <> "" Then
        For j = LBound(Arr, 2) - 1 To UBound(Arr, 2) - 1
           Tmps(m, j) = Arr(i, j + 1)
        Next j
        m = m + 1
 End If
Next i
Sheets("teste").Range("B1").Resize(UBound(Tmps, 1) + 1, UBound(Tmps, 2) + 1) = Tmps
End Sub

bravo Mr Amir

Amir reste Amir

les deux macro fonctionne

merci encor une fois

OK si ton problème est résolut n’oublie pas de cocher le bouton résolut :) et a bientôt