tableau de valeurs sur plage de cellules non contigues

[jaccard]

Hello, un vrai titre à la PROUST

je voudrais obtenir un tableau à deux dimensions d'une plage de cellules non contigues

exemple pour la plage "a1:a2,c1:c2,f1:g2" :

le tableau(1,1) = valeur de "a1"
le tableau(1,2) = valeur de "a2"
le tableau(2,1) = valeur de "c1"
le tableau(2,2) = valeur de "c2"
le tableau(3,1) = valeur de "f1"
le tableau(3,2) = valeur de "f2"
le tableau(4,1) = valeur de "g1"
le tableau(4,2) = valeur de "g2"

en utilsant l'exemple suivant je n'obtiens que :

le tableau(1,1) = valeur de "a1"
le tableau(1,2) = valeur de "a2"

Sub essai()
Dim vntMonTableau As Variant
vntMonTableau = Me.Range"a1:a2,c1:c2,f1:g2").Value
End Sub

avec .Areas je connais le nombre de zones non contigues mais comment 'concatener' les valeurs dans un tableau, en rédigeant ce message, je pense qu'avec redim et preserve j'ai une chance, j'va essayer

Merci d'avance pour vos réponse ;-) domi

 

[Alain]

Bonjour,


Tu peux essayer avec le code ci-dessous :

Option Explicit
Dim vntMonTableau() As Variant
Sub essai()
Dim i As Integer, j As Integer
ReDim vntMonTableau(3, 1)
For i = 0 To 1
vntMonTableau(0, i) = Range("A1").Offset(i, 0)
Next
For i = 0 To 1
vntMonTableau(1, i) = Range("C1").Offset(i, 0)
Next
For i = 0 To 1
vntMonTableau(2, i) = Range("F1").Offset(i, 0)
Next
For i = 0 To 1
vntMonTableau(3, i) = Range("G1").Offset(i, 0)
Next
'
' Petit essai de restitution
'
For i = 0 To 3
For j = 0 To 1
Range("A4").Offset(i, j) = vntMonTableau(i, j)
Next
Next
End Sub


@+

 

[jaccard]

Hello, Merci alain
mais l'adresse de la plage de cellule n'est pas statique et j'avais oublié de préciser que les diffèrents plages de cellule comporte les mêmes lignes
exemple "A8:B10,H8:L10,M8:M10"

j'ai trouvé une solution longue mais éfficace:

Function AreasValue(objAreas As Range)
Dim vntValue, vntTemporyValue As Variant
Dim intBound, intBeginSeparator, intEndSeparator As Integer
Dim intIndexColumn, intIndexRow As Integer
Dim strAddress As String
Dim objRange As Range

'l'adresse donnée par objAreas.Address peut être tronquée
'exemple : colonne 1 contenant 50 constantes séparées par une cellule vide
'puis Me.Columns(1).SpecialCells(xlConstants).Address
'ne dépasse pas la ligne 85 !!
'avec cette boucle je récupère l'adresse complète
For Each objRange In objAreas.Areas
strAddress = strAddress & "," & objRange.Address
Next objRange
strAddress = Right(strAddress, Len(strAddress) - 1)

Do
intEndSeparator = InStr(intBeginSeparator + 1, strAddress, ",")
If intEndSeparator = 0 Then intEndSeparator = Len(strAddress) + 1
With Me.Range(Mid(strAddress, intBeginSeparator + 1, (intEndSeparator - 1) - intBeginSeparator))
vntTemporyValue = .Value
If IsArray(vntValue) = False Then
intBound = .Columns.Count
vntValue = vntTemporyValue
Else
ReDim Preserve vntValue(1 To UBound(vntValue), 1 To intBound + .Columns.Count)
For intIndexColumn = 1 To .Columns.Count
For intIndexRow = 1 To UBound(vntValue)
vntValue(intIndexRow, intIndexColumn + intBound) = vntTemporyValue(intIndexRow, intIndexColumn)
Next intIndexRow
Next intIndexColumn
intBound = intBound + .Columns.Count
End If
End With
intBeginSeparator = intEndSeparator
Loop Until intEndSeparator > Len(strAddress)
AreasValue = vntValue
End Function