Microsoft 365 redim array ne marche pas

thenesol

XLDnaute Junior
bonjour à tous

j'ai un array "tablo1" dont je ne voudrais garder que les 100 premières lignes

mais le code suivant ne le modifie pas, c'est à dire qu'il a toujours ses 8000 lignes
pourquoi ?

ReDim Preserve tablo1(1 To 100, 1 To ncol)

merci...
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Thenesol,
Avec "Redim Preserve", on ne peut modifier que la dernière dimension. Dans votre cas vous ne pouvez redimensionner que le nombre de colonnes.
Si vous utilisez le mot clé "preserve", vous pouvez redimensionner uniquement la dernière dimension du tableau et que vous ne pouvez pas modifier le nombre de dimensions du tout.
Le plus simple est peut être de transférer les 100 première ligne du tablo1 dans un tablo2.
 

patricktoulon

XLDnaute Barbatruc
Bonjour
c'est sans compter sur les idées farfelues à la patricktoulon
pour le coup je fait une macro redim_PreserveRow

demonstration
VB:
Sub test()
    Dim Tablo

    Tablo = Range("A1:CV25000").Value

    MsgBox "avant " & vbCrLf & "mon tableau a " & UBound(Tablo) & " lignes et " & UBound(Tablo, 2) & " colonnes "

    Redim_preserveRow Tablo, 1, 100

    MsgBox "apres " & vbCrLf & "mon tableau a " & UBound(Tablo) & " lignes et " & UBound(Tablo, 2) & " colonnes "
End Sub

Sub Redim_preserveRow(ByRef Tablo, minLig, MaxLig)
    Dim L
    L = Evaluate("ROW(" & minLig & ":" & MaxLig & ")")

    Tablo = Application.Index(Tablo, L, 0)
End Sub
 

thenesol

XLDnaute Junior
voila un extrait du code :
Redim_preserveRow
ne conserve que la 1ere colonne


Sub Redim_preserveRow(ByRef Tablo, minLig, MaxLig)
Dim L
L = Evaluate("ROW(" & minLig & ":" & MaxLig & ")")

Tablo = Application.Index(Tablo, L, 0)
End Sub

Sub compare_3()
Dim ncol%, i%, j%, reduclg%, wb1 As Workbook
Dim tablo1, tablotemp As Variant
Dim ws1 As Worksheet
Dim Fichier1 As Variant

reduclg = 100
ncol = 10

Fichier1 = Application.GetOpenFilename("CSV Files (*.CSV), *.csv")
If Fichier1 = False Then MsgBox "Ouvrez '" & Fichier1 & "'...": Exit Sub ' pas de fichier on quitte

On Error Resume Next
Set wb1 = Workbooks.Open(Filename:=Fichier1, Local:=True)
If wb1 Is Nothing Then MsgBox "Ouvrez '" & Fichier1 & "'...": Exit Sub

tablo1 = wb1.Sheets(1).[A1].CurrentRegion.Resize(, ncol) 'matrice, plus rapide

Redim_preserveRow tablo1, 5, 10

End Sub
 

thenesol

XLDnaute Junior
pardon ?
voilà ce que j'obtiens en sortie
à jeun

1700060913486.png
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Re,
@patrick,
Si l'array en question est strictement interne au VBA et non la copie d'un range, alors je n'ai pas trouvé comment votre fonction peut marcher.
Voir PJ. Je remplit un array 100*4 et je restitue un array 10*4, les deux restitutions sont les mêmes.
Où est le piège ?
 

Pièces jointes

  • Patrick.xlsm
    18.5 KB · Affichages: 3

Discussions similaires

Statistiques des forums

Discussions
314 626
Messages
2 111 291
Membres
111 092
dernier inscrit
ThomasU3