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

cathodique

XLDnaute Barbatruc
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.
 

Pièces jointes

  • Classeur1.xlsm
    11.3 KB · Affichages: 39

cathodique

XLDnaute Barbatruc
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

XLDnaute Accro
Bonjour Nicole, bonjour Cath.

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

VB:
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

XLDnaute Barbatruc
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.
VB:
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

XLDnaute Accro
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.

VB:
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

XLDnaute Accro
Ton code corrigé.

VB:
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

XLDnaute Barbatruc
Supporter XLD
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:
VB:
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
 
Dernière édition:

cathodique

XLDnaute Barbatruc
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.
 

Discussions similaires

Statistiques des forums

Discussions
311 725
Messages
2 081 940
Membres
101 845
dernier inscrit
annesof