Tableau (MesEleves) Redim à compléter avec ReDim Preserve (clef Concatenation)

[laurent950]

Bonsoir le forum, le fil,

J’aimerais comprendre la suite d’un tableau alimenté a partir d’une feuille Excel.

Avec l’instruction Redim

Puis coller les valeurs du tableau (en mémoire) dans des cellules d’une feuille Excel.

Ce même tableau existant (en mémoire) j’aimerais lui ajouter une colonne supplémentaire (toujours en mémoire) cette colonne serais une clef de concaténation (à partir de valeur déjà en mémoire) dans le tableau existant.

Avec l’instruction ReDim Preseve.

J’ai commencé quelque choses, joint le code avec le fichier Excel.

Le tableau s’appelle MesEleves.

Code : (Lisible est très propre avec des commentaires dans l'éditeur VBA)

Sub test22()
Dim MesEleves() As Variant
Dim i As Integer
Dim j As Integer 'Nbre éléments du tableau

'============================================================================================================
' Feuil2 pour mettre le resultat
Set F2 = ThisWorkbook.Worksheets("Feuil2")

' Derniere cellule non vide de la colonne A
derCA = Range("a65536").End(xlUp).Row

' Derniere cellule non vide de la ligne 1
derL1 = Range("IV1").End(xlToLeft).Column
'============================================================================================================

' Boucle pour remplir le tableau si la note de l'eleve est égale à 19
' Avec l'instruction redim (pour comprendre)
For j = 1 To derCA 'derL1 Derniere cellule non vide de la ligne 1
For i = 1 To derL1 ' derCA Derniere cellule non vide de la colonne A
'Engestriment de tous les éléments du tableau (Mise en mémoire de celui-ci = MesEleves)
ReDim MesEleves(j, i)
MesEleves(j, i) = Cells(j, i) ' Remplis le tableau (Toutes les cellules de 3 colonnes et 15 lignes)
Debug.Print MesEleves(j, i) ' lecture de la cellule remplis (fenêtre d'excécution éditeur VBA)
Next i
Next j

' =====================================================================================
' Une fois celle-ci dans le tableau, je ne sais pas :
' - copier les valeur du tableau MesEleves dans la Feuil2
' Soit :
' Tous le tableau en une fois. (3 colonnes et 15 lignes)
' ou
' Juste une colonne du tableau (Toutes la colonne éléves)
' ou
' Une ligne du tableau (Salle224 /VALERIE / 12)
' ou
' Par exemple ou jsute une valeur (Jeanne dans une cellule)
' ou
' Par exemple des valeurs a coller dans des cellules :
' - Jeanne = une cellule et 0 = une cellule

' C'est le faite de récuperer des valeur dans le tableau et les
' Coller dans excel.

' ===========================================================================================

' =====>>>> Divers test non concluant ???

' =====>>>> F2.Cells(1, 1) = MesEleves
' =====>>>> F2.Range(F2.Cells(1, 1), F2.Cells(UBound(MesEleves, 1), UBound(MesEleves, 1))) = MesEleves
' =====>>>> F2.Range(F2.Cells(1, 1), F2.Cells(UBound(MesEleves, 1))) = MesEleves



' SUITE AVEC ReDim Preseve

' ===========================================================================================
' **** Comment se servire de l'instruction ReDim Preserve pour completer *****
' **** La dimension du tableau MesEleves est completer ce tableau *****
' **** Sans perdre les donner précedente contenu dans MesEleves *****
' ===========================================================================================


' ===>>> Associer la classe avec la Note = 19 :
' Ici le Tableau contient les Notes 19 (soit 3 fois la Note 19) dans le Tableau MesEleves
' Avec ReDim Preserve (ajouter des valeur aux tableau MesEleves)
' La colonne Clef (A et C) doit être dans la mémoire tableau est être une clef de concatenation
' de la Classe et Note (Uniquement si la note est de strictement = 19)

' =====================================================================================
' Ne fonctionne pas
' je sais pas ajouter la clef de concatenation a la mémoire du tableau
' MesEleves avec l'instruction Redim Preserve (aux tableau existant MesEleves)

For i = 1 To UBound(MesEleves, 2) ' Colonne = 3 LBound(MesEleves, 2) Soit deuxieme dimension
For j = 1 To UBound(MesEleves, 1) ' Ligne = 15 LBound(MesEleves, 1) soit premiere dimension

If MesEleves(j, i) = 19 Then ' Condition si la note est strictment = 19
'Redimension du tableau en conservant ses éléments
' =====================================================================================
x = 46 + i ' ICI JE COMPREND PLUS ?
ReDim Preserve MesEleves(x)
MesEleves(x) = Cells(i, 1) & Cells(i, 3)
Debug.Print MesEleves(x)
' =====================================================================================
End If
Next j
Next i


' =====================================================================================

' Pour la suite j'aimerais à present que le tableau contient maintenant une dimensions
' Suplémentaire soit la clef (A et C) soit la contaténation de :

' Soit : clef (A et C)
' Salle227 / 19 soit = Salle22719
' Salle224 / 19 soit = Salle22419
' Salle227 / 19 soit = Salle22719

' Et coller le resultat des lignes de se tableau redimensioné (MesEleves) en :
' En cellule A10 : point de départ
' Correspondant aux lignes de la clef de concatenation.

' soit:
' Salle22719
' Salle22419
' Salle22719


End Sub

Remerciant le Forum pour cette aide qui me serait bien utile.

Laurent.

 

[laurent950]

Re : Tableau (MesEleves) Redim à compléter avec ReDim Preserve (clef Concatenation)

Bonsoir,

J'ai touvé cette astuce pour asocier une variable tableau a un remplissage avec un format et cela est pas en decalage avec la restitution du resultat stocké dans un tableau mais sur des grande données je ne sais pas se que cela vault ?

un site excel sur les format trés pratique aussi

Color Palette and the 56 Excel ColorIndex Colors

je joint le fichier simple avec l'exemple :

 ' Module (Macro)


Sub TabCouleur()

Dim T() As Variant
Dim F1 As Worksheet
Set F1 = ThisWorkbook.Worksheets("Feuil1")

' Efface les valleur de la feuilles
Range("B3:C18").ClearContents

' Efface les couleurs
    lign = 3
    col = 3
SansCouleur F1, lign, col

' Tableau
T = Range("A3:A18").Value
pos = Range("a3").Row

' Redimenion du tableau soit deux colonne supplémentaire
ReDim Preserve T(1 To 16, 1 To 3)

' Boucle
For i = 1 To UBound(T, 1)
    If T(i, 1) = "F" Then
        T(i, 2) = T(i, 1)
        T(i, 3) = "Sans couleur"
    ElseIf T(i, 1) = "y" Then
        T(i, 2) = T(i, 1)
        ' Procédure de mise en couleur
        lign = i + 2
        col = 2
        Resi = 2
        AvecCouleur F1, lign, col, Resi
        T(i, 3) = "Couleur"
    End If
Next i
        
' Colle version 1
'F1.[B3].Resize(UBound(T, 1), UBound(T, 2)) = T

' Mieux
For i = 2 To 3
     F1.Cells(3, i).Resize(UBound(T, 1)) = Application.Index(T, , i)
 Next i
 
' efface tous le Tableau T()
Erase T

Cells(1, 1).Select

End Sub

' ______________________________________________________________________________________________________

' Procédure Module (Couleur)


Sub AvecCouleur(ByVal F1, lign, col, Resi)
' Procedure (Renvois pas de resultat)

' faux Avec Souleur
    F1.Cells(lign, col).Resize(, Resi).Select
    With Selection
        .Font.Name = "Calibri"
        .Font.FontStyle = "Gras"
        .Font.Size = 11
        .Font.Underline = xlUnderlineStyleNone
        .Font.Color = 255
        .Font.ThemeFont = xlThemeFontMinor
        '.Borders(xlDiagonalDown).LineStyle = xlContinuous
        '.Borders(xlDiagonalUp).LineStyle = xlContinuous
        .Interior.Pattern = xlSolid
        .Interior.PatternColorIndex = xlAutomatic
        .Interior.Color = 65535
    End With
    
End Sub
Sub SansCouleur(ByVal F1, lign, col)
' Procedure (Renvois pas de resultat)

' Sans Couleur
    F1.Range(F1.Cells(lign, 2), F1.Cells(18, col)).Select
    With Selection
        .Font.Name = "Calibri"
        .Font.FontStyle = "Normal"
        .Font.Size = 11
        .Font.Underline = xlUnderlineStyleNone
        .Font.ColorIndex = xlAutomatic
        .Font.ThemeFont = xlThemeFontMinor
        '.Borders(xlDiagonalDown).LineStyle = xlNone
        '.Borders(xlDiagonalUp).LineStyle = xlNone
        .Interior.Pattern = xlNone
    End With
    
End Sub

laurent

 

[laurent950]

Re : Tableau (MesEleves) Redim à compléter avec ReDim Preserve (clef Concatenation)

Bonsoir,

J'avais comme idées d'inclure une formule mathématique simple sans Matriciel dans un tableau
j'y suis arrivée pour continué la suite des Variable Tableau

exemple

'Sans formules matricielles :
 
Sub test()
Dim T As Variant
T = Range("C1:D6")

ReDim Preserve T(1 To 6, 1 To 3)

For i = 1 To UBound(T, 1)

T(i, 3) = "=" & T(i, 1) & "*" & T(i, 2) ' Formule

Next i

For i = 3 To 3
Cells(1, 1).Resize(UBound(T, 1)) = Application.Index(T, , i)
Next i

End Sub

Par contre je sais pas si il y ala même chose en plus simple. il y a des autres exemples sur ce tuto mais
c'est pour récupérer des formules existantes (et copier en variable tableau) pour retitué le resulat ailleur
en faite j'aimerais les crées comme dans cette exemple (je sais pas si il y a mieux en matiére de code)

Merci au forum pour votre aide ou idées


Laurent

 

[MichD]

Re : Tableau (MesEleves) Redim à compléter avec ReDim Preserve (clef Concatenation)

Bonjour,


Voici 3 façons différentes d'introduire la même formule que toi dans la colonne A dans ton fichier exemple.

Sub test1()
Dim Rg As Range
With Feuil1
    Set Rg = .Range("C1:D" & .Range("C65536").End(xlUp).Row)
End With
Rg.Offset(, -2).Resize(, Rg.Columns.Count - 1).Formula = _
        "=" & Rg(1).Address(0, 0) & "*" & Rg(1).Offset(0, 1).Address(0, 0)
End Sub
'-----------------------------
Sub test2()
Dim T()
T = Range("A1:A6").Formula
Range("G1").Resize(UBound(T, 1)).Formula = Application.Transpose(T)
End Sub
'-----------------------------
Sub test3()
Range("A1").Formula = "=C1*D1"
Range("A1:A6").FillDown
End Sub

 

[Staple1600]

Re : Tableau (MesEleves) Redim à compléter avec ReDim Preserve (clef Concatenation)

Bonjour le fil

Et en voici 3 autres

Sub Macro1()
Range("A1:A6").FormulaR1C1 = "=RC[2]*RC[3]"
End Sub

Sub Macro2()
Range("A1:A6").FormulaLocal = "=C1*D1"
End Sub

Sub Macro3()
[A1:A6].FormulaLocal = "=C1*D1"
End Sub

 

[laurent950]

Re : Tableau (MesEleves) Redim à compléter avec ReDim Preserve (clef Concatenation)

Bonjour MichD et Staple1600,

Cela faisait longtemps que ne nous nous somme pas croisé sur le Forum et je tenais à vous remercier pour les compléments d'informations apporté à mes nombreuses questions.
Je vais faire les tests au travail pour adapter cela, mais déjà vos solutions me conviennent toute à fait, et je vous en remercie tous les deux

Laurent

 

[laurent950]

Re : Tableau (MesEleves) Redim à compléter avec ReDim Preserve (clef Concatenation)

Bonsoir le Forum,

Comment construire une formule a partir de données dans des cellules dans la feuille Excel, Garder en mémoire les coordonnées des cellules (Construire cette formules et l’intégrés dans une variable tableau et la restituer en une seul fois)

Exemple ci-joint :

En cellule D3 :E6 une plage de données que je garde en plage Objet

Puis un tableau T2 pour que je puisse avoir les limites de cette même plage
Je ne sais pas avoir les limites avec la plage Objet donc je rajoute de colonne
Supplémentaire a T2 pour stocker les nouvelles données avec redim preserve

ReDim Preserve T2(1 To UBound(T2, 1), 1 To 4)

Pour le reste pour avoir la formule j’ai rien trouver d’autre car avec cette option, donne le résultat sans les cellule de référence

'T2(i, 4) = Application.Worksheets.Sum

Voici le code :

Option Base 1
'Sans formules matricielles :
 
Sub test()

fin = Range("D65536").End(xlUp).Row
Dim T1, T2 As Variant
Set T1 = Range(Cells(3, 4), Cells(fin, 5)) ' Objet pour l'address
T2 = Range(Cells(3, 4), Cells(fin, 5))

ReDim Preserve T2(1 To UBound(T2, 1), 1 To 4)

For i = 1 To UBound(T2, 1)
    T2(i, 3) = "=" & T1(i, 1).Address & "+" & T1(i, 2).Address  ' Formule somme
    T2(i, 4) = "=" & T1(i, 1).Address & "*" & T1(i, 2).Address  ' Formule multiplication
Next i

For i = 3 To 4
    k = k + 1
    Cells(3, k).Resize(UBound(T2, 1)) = Application.Index(T2, , i)
Next i

End Sub

Ps : Si vous avez une idée pour simplicifier se code ou pour avoir la même choses en plus simple en evitant la plage objet et la création d'un tableau pour avoir les limites de cette plage objets en passant par une autres étapes
au passage si je fait juste redim a la place de redim preserve jepeux avoir le tableau T2 avec le même nombre de line et de colonne sans en ajouter 2 autres suplémentaire avec redim preserve (car les donnée ne sont pas conserver avec redim "mais je ne trouve pas cela très propre")

Laurent

Ps : Ce Liens est juste pour moi "Ou pour des personnes désirant apprendre avec" un travail en variable Tableau et a ajouter sur le fichier la formule que j'ai faite avec :
application.worksheetfunction.sum "Mais le resultat est inscrit en dur sans les référence cellule"
et dont j'aimerais faire avec cette astuce a refaire "Code Propre et interressant" VariableTableau
Lien :
https://www.excel-downloads.com/thr...-de-5-chevaux-avec-la-somme-des-cotes.188650/

 

[david84]

Re : Tableau (MesEleves) Redim à compléter avec ReDim Preserve (clef Concatenation)

Bonsoir,
Je n'ai pas trop compris l'intérêt mais tu peux simplifier comme ceci (pas la peine de passer par un tableau si tu instancies une plage) :

Sub test2()
Dim Pl1 As Range, Pl2 As Range
Set Pl1 = [D2].Offset(1, 0).Resize([D2].CurrentRegion.Rows.Count - 1, _
[D2].CurrentRegion.Columns.Count)
Set Pl2 = [A2].Offset(1, 0).Resize([D2].CurrentRegion.Rows.Count - 1, _
[D2].CurrentRegion.Columns.Count)
For i = 1 To Pl1.Rows.Count
    Pl2(i, 1) = "=" & Pl1(i, 1).Address & "+" & Pl1(i, 2).Address  ' Formule somme
    Pl2(i, 2) = "=" & Pl1(i, 1).Address & "*" & Pl1(i, 2).Address  ' Formule multiplication
Next i
End Sub

A+

 

[laurent950]

Re : Tableau (MesEleves) Redim à compléter avec ReDim Preserve (clef Concatenation)

Merci david84,

Pour ma part je vais consigner cette version qui est plus lisible pour ma part bien que la votre est aussi très très bien.

Est-ce que vous connaissais une solution pour rentrer la formule dans le tableau plus simplement

Avant:
T2(i, 1) = "=" & T1(i, 1).Address & "+" & T1(i, 2).Address

Après: avec les adresses comme ci-dessus ?
T2(i, 1) = WorksheetFunction.Sum(T1(i, 1), T1(i, 2))

Je vous remercie pour cette astuce, au plaisir de vous lire et vous répondre.

Voici le code simplifié :

Option Base 1
'Sans formules matricielles :

Sub test()
' fin derniere cellule non vide colonne D
fin = Range("D65536").End(xlUp).Row                             
Dim T1 As Range   ' T1 Plage    de type range
Dim T2() As Variant  ' T2 Tableau  de type Variant
  ' T1 Objet    plage d'adresse
Set T1 = Range(Cells(3, 4), Cells(fin, 5)) 
' Dimension du tableau variant T2                   
ReDim T2(1 To fin - 2, 1 To 2)  
' Compte le nombre de ligne de la plage objet T1                               
For i = 1 To T1.Rows.Count    
' Formule somme                                 
T2(i, 1) = "=" & T1(i, 1).Address & "+" & T1(i, 2).Address
' Formule multiplication  
 T2(i, 2) = "=" & T1(i, 1).Address & "*" & T1(i, 2).Address 
Next i
For i = 1 To 2
  ' k c'est un compteur 
 k = k + 1 
' Copie la Colonne Du tableau en mémoire i pour colonne                                                     
    Cells(3, k).Resize(UBound(T2, 1)) = Application.Index(T2, , i) 
Next i
End Sub

Laurent

 

[Staple1600]

Re : Tableau (MesEleves) Redim à compléter avec ReDim Preserve (clef Concatenation)

Bonsoir à tous

laurent950
Si tu veux faire simple, ce genre de syntaxe soumise plus bas dans le fil devrait suffire non ??
https://www.excel-downloads.com/thr...vec-redim-preserve-clef-concatenation.173610/

En incluant la détection, de la dernière cellule non vide

Range("A1:A" & [A65536].End(xlUp).Row).FormulaR1C1 = "=RC[2]*RC[3]"

PS: Tout comme david84 (que je salue au passage), je ne comprends pourquoi tu t'obliges à passer par un tableau là ou une seule ligne de code peut suffire ?

 

[david84]

Re : Tableau (MesEleves) Redim à compléter avec ReDim Preserve (clef Concatenation)

Bonsoir,

For i = 1 To T1.Rows.Count
' Formule somme
T2(i, 1) = "=" & T1(i, 1).Address & "+" & T1(i, 2).Address
' Formule multiplication
T2(i, 2) = "=" & T1(i, 1).Address & "*" & T1(i, 2).Address
Next i

quel est l'intérêt d'utiliser les adresses d'une plage dans un array pour faire une addition et une multiplication ?

For i = 1 To 2
  ' k c'est un compteur 
k = k + 1 
' Copie la Colonne Du tableau en mémoire i pour colonne                                                     
   Cells(3, k).Resize(UBound(T2, 1)) = Application.Index(T2, , i) 
Next i

Pourquoi utiliser Index alors que

Cells(3, 1).Resize(UBound(T2), UBound(T2, 2)) = T2 ' Copie la Colonne Du tableau en mémoire i pour colonne

suffit ?
Si tu nous expliquais un peu le but de la manœuvre, cela nous permettrait peut-être de mieux comprendre ton code.
A+

Edit : bonsoir JM

 

[MichD]

Re : Tableau (MesEleves) Redim à compléter avec ReDim Preserve (clef Concatenation)

Pourquoi passer par un tableau (array)?
On peut très bien faire la même chose avec un objet "Range"

Sub test()

Dim Rg As Range
Set Rg = Range("D3:E8") 'Plage de données

'2 façons d'écrire la formule somme :
Range("A3:A8").Formula = "=" & Rg(1, 1).Address(0, 0) & "+" & Rg(1, 2).Address(0, 0)
Range("B3:B8").Formula = "=sum(" & Rg(1, 1).Address(0, 0) & ":" & Rg(1, 2).Address(0, 0) & ")"

'multiplication
Range("C3:C8").Formula = "=" & Rg(1, 1).Address(0, 0) & "*" & Rg(1, 2).Address(0, 0)

End Sub

 

[laurent950]

Re : Tableau (MesEleves) Redim à compléter avec ReDim Preserve (clef Concatenation)

Bonsoir, Staple1600, david84, MichD

Cela fait plaisir de vous retrouver sur ce forum, pour vous expliquer je vais essayer :
Pour faire simple j’ai beaucoup de calcul à faire sur un seule fichier Excel et qui sont tous très différent, des sommes, multiplication, division, des sommes .si .ens, etc. . Aussi d’autre plus complexe (sauf matriciel)

Taille du fichier (12 000 lignes sur une 60 colonne) avec 40 de calculs par lignes.
J’ai besoins de vérifier mes formules que je construis pour vérification. Sois Par moi-même ou une tierce personne pour explications.

Je travaille en type orienté OBJET et je récupère les données sur un ensemble de classeur (que j’ouvre avec VBA et d’où je récupère les données que je rapatrie et stocké dans (une variable tableau).

La solution c’est de collé en une seul fois tous ce que j’ai rentré dans le tableau. Enfin je pense que cela est la solution car je n’ai pas testé sur un si grand nombre de données. Et je ne sais pas ce que cela donne.

Ce que je sais la copie Cellule par cellule avec une boucle sur un si grand nombre de calcul, excel ralenti la macro avance plus vite que le remplissage et des incohérences et erreur sont écrite dans les cellule.

Je dois pour cela adapter la meilleur solution donc je prends en comptes vos méthodes et les appliquerais aussi, et je verrais la meilleur solution adapter à mon travail.
La question que je peux me poser actuellement c’est : Est-ce que mon code tiens la route, ou est ‘il faux ou peux va-t-il crée des erreurs ?

J’aimerais aussi me servir de la propriété de la classe Range à l’adresse des cellules de la plage en Objet ? Pour affecter des formats, Comme couleur, format police, enfin toute la propriété (de la classe range) associer à cette solution si elle tient la route ?

Je suis aussi entrain de creuser en parallèle la construction de classes et un super classe (si possible), avec des objets d’instances de la classe et aussi de voir si c’est possible d’utiliser des variables d’instances de la classe.

Le but est de construire mes propre classes indépendamment des classes prédéfinit et function prédéfini par l’application Excel VBA est être indépendant des mises à jour qui m’oblige à reprendre les codes au fil des versions

Pour l’instant je travail (sans module de classe) je verrais par la suite pour la construction (au passage je vois bien un Module de classe sur les trie (Quick Sort, trie a bulle, etc.) ou sur la recherche de fichier dans l’explorateur Windows « filesearch vba » ayant disparu depuis 2007 (Donc en faire une ou en l’adapté une) à voir aussi et plein d’autre choses que l’on fait souvent.

Merci pour m’avoir lu et aussi pour me dire si je fais fausse route sur mon code précédemment cité.

Ce n’est pas facile d’expliquer précisément ce que je fais ou veux faire mais j’ai essayé.
Merci à vous tous est votre aide précieuse, qui m’a permis de bien progresser depuis mes début sur ce site.

Gestion des dossiers et fichiers

VBA : Gestion des fichiers, dossiers et lecteurs

www.info-3000.com

Laurent

 

[MichD]

Re : Tableau (MesEleves) Redim à compléter avec ReDim Preserve (clef Concatenation)

Selon tes explications, le plus simple est de créer tes formules seulement pour chacune des colonnes.
Tu t'assures que chaque formule de la première ligne est valide et retourne exactement ce que tu désires.

Après c'est plutôt simple.

A ) tu passes Excel en mode de calcul manuel
B ) Tu inscris par VBA, la formule appropriée pour chacune des colonnes
Une façon simple d'obtenir leur syntaxe, tu utilises ceci en supposant que ta formule est en A1
Range("A2") = "'" & range("A1").Formula
Tu obtiendras en A2 l'essentiel de la syntaxe. Il reste habituellement à entrer les variables si besoin!

C ) Tu détermines la dernière ligne jusqu'où tu dois inscrire les formules

D ) Pour recopier toutes les formules sur toute la plage de cellules, tu utilises ceci :
Range("A1:Z" & derlig).Filldown
Cette ligne de code copie les formules et le format de la première ligne pour toutes les lignes de la plage de cellules.

E ) Tu passes Excel en mode de calcul automatique au besoin ou tu utilises le raccourci clavier F9 pour lancer la
mise à jour des formules.

Une autre façon de faire, tu crées un "NOM" de la collection "Names" pour chacune des formules sur la première tu tableau.
Si tu as 10 colonnes, tu as 10 noms et chacun fait référence à une formule. Utilise un nom significatif pour chaque formule.

Maintenant, sur l'ensemble de la colonne, tu n'as qu'à inscrire la même donnée =Formule1
C'est simple et tu peux te passer d'une macro. Pour l'entretien de ton fichier, si tu dois modifier
une de ces formules, tu n'as qu'une seule formule à modifier...