XL 2010 [RESOLU]Boucle feuille vers Array, puis Array vers feuille

[cathodique]

Bonjour,
Je m'exerce sur les arrays mais aujourd'hui n'est pas mon jour.
Soient 2 colonnes (A et B) comportant des chiffres et des lettres.
Je voudrais boucler sur la colonne A, et ne récupérer que les lignes numériques
dans un array, puis transférer cet array vers la feuille.

C'est tout simple, mais je ne m'en sors pas depuis ce matin.

Merci de venir à mon secours.

 

[cathodique]

Salut Nicole🙂,

Très gentil de ta part mais ce n'est pas comme ceci que je voulais le faire. Ton code me sera utile, j'en suis sûr.

Je voulais vraiment faire une boucle sur la colonne A, for each cel in colonne A et alimenter un array (pas un dico). Et par la suite transférer l'array sur la feuille.
Je m'exerce mais depuis ce matin, tous essais ont été vains.

merci beaucoup.

 

[thebenoit59]

Bonjour Nicole, bonjour Cath.

Une proposition différente de celle de Nicole.
Je ne travaille que sur des Array comme souhaité.

Sub loopArray()
Dim arr1(), arr2(), i&, j&, k&, n&

arr1 = Range("A1:B" & Range("B" & Rows.Count).End(xlUp).Row)
For i = LBound(arr1) To UBound(arr1)
    If IsNumeric(arr1(i, 1)) Then n = n + 1
Next i

ReDim arr2(1 To n, 1 To 2)
k = 0
For i = LBound(arr1) To UBound(arr1)
    If IsNumeric(arr1(i, 1)) Then
        k = k + 1
        For j = 1 To 2
            arr2(k, j) = arr1(i, j)
        Next j
    End If
Next i

[d1].Resize(UBound(arr2, 1), UBound(arr2, 2)).Value = arr2
End Sub

 

[cathodique]

Re, Nicole, Thebenoit59,

Désolé, je me suis mal fait comprendre. La boucle, je voudrais la faire sur les cellules de la colonne A.

c'est à dire ne prendre dans l'array que ce qui répond au test (colonne A=numérique).

et dans l'array résultat, il n'y aura que les valeurs numériques de colA et valeur correspondante de la colonne B.
Voici un parmi une masse de codes que j'ai essayé. Je n'arrive pas à trouver mon erreur.

Sub TransfertConditionnel()
    Dim plg As Range, Tblo, cel As Range
    Dim j As Long
    Set plg = Range("a1:a" & Cells(Rows.Count, 1).End(xlUp).Row) 'CurrentRegion
        For Each cel In plg
        If IsNumeric(cel.Value) Then
            j = j + 1
            ReDim Preserve Tblo(1 To 2, 1 To j)
            Tblo(1, j) = cel.Value
            Tblo(2, j) = cel.Offset(0, 1).Value
            End If
        Next cel
        Range("g10").Resize(UBound(Tblo, 1), UBound(Tblo, 2)).Value = Tblo
        Erase Tblo

    End Sub

 

[thebenoit59]

Mon premier exemple travaille tel que tu le souhaites sauf que nous enregistrons ta zone dans un tableau virtuel, sur un grand nombre de lignes tu gagneras en temps.

Ce qui ne change pas énormément quand à ta méthode, en effet tu places ta colonne A dans un objet et tu le boucles ensuite.

Sub loopArray2()
Dim arr2(), i&, j&, k&, n&

For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
    If IsNumeric(Range("A" & i).Value) And Range("A" & i).Value <> "" Then n = n + 1
Next i

ReDim arr2(1 To n, 1 To 2)
k = 0
For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
    If IsNumeric(Range("A" & i).Value) And Range("A" & i).Value <> "" Then
        k = k + 1
        For j = 1 To 2
            arr2(k, j) = Range("A" & i).Offset(, j - 1).Value
        Next j
    End If
Next i

[d1].Resize(UBound(arr2, 1), UBound(arr2, 2)).Value = arr2
End Sub

 

[thebenoit59]

Ton code corrigé.

Sub TransfertConditionnel()
    Dim plg As Range, Tblo(), cel As Range
    Dim j As Long
    Set plg = Range("a1:a" & Cells(Rows.Count, 1).End(xlUp).Row) 'CurrentRegion
       For Each cel In plg
        If IsNumeric(cel.Value) Then
            j = j + 1
            ReDim Preserve Tblo(1 To 2, 1 To j)
            Tblo(1, j) = cel.Value
            Tblo(2, j) = cel.Offset(0, 1).Value
            End If
        Next cel
        Range("g10").Resize(UBound(Tblo, 2), UBound(Tblo, 1)).Value = Application.Transpose(Tblo)
        Erase Tblo

    End Sub

 

[mapomme]

Bonsoir à tous,

Attention à l'utilisation de Transpose !

Au délà de 65536 lignes à transposer, on aboutit à une erreur (voir ici)

• pour Excel 2010, l'erreur est signalée à l'exécution -> Type incompatible (erreur 13)
• pour Excel 2013 & 2016, aucune erreur n'est signalée, mais le résultat est faux

Voici un code qui évite le transpose:

Sub extract()
Dim T, i&, n&
  Application.ScreenUpdating = False: Range("g10:h" & Rows.Count).ClearContents
  T = [a1].CurrentRegion
  For i = 1 To UBound(T)
    If IsNumeric(T(i, 1)) And Not IsEmpty(T(i, 1)) Then
      n = n + 1: T(n, 1) = T(i, 1): T(n, 2) = T(i, 2)
    End If
  Next
  if n >0 then [g10].Resize(n, 2) = T
End Sub

 

[cathodique]

Tu veux que je te dise, vraiment saturé.
La correction de ton code fonctionne parfaitement. J'ai corrigé mon code en me basant sur le tien.
Et devine quoi? il plante sur Redim (incompatibilité de type). je viens de me rendre compte que j'avais déclaré Tblo en variant par défaut c-à-d comme ceci Tblo.

Merci beaucoup;

@Nicole: je viens de tester ton code, ce n'est pas le résultat escompté. Merci quand même.
edit: Merci Mapomme, pour tes explications. Très gentil, j'apprécie vraiment.

Bonne soirée à tous.