Ecriture rapide d'un tableau

Le 29/03/21 Í  13:51, Alf a écrit :

Bonjour,
J'ai développé une macro qui met en mémoire, dans un tableau, une liste de variables sous la forme String (3000 variables environ)
Je dois écrire ensuite ces variables dans une feuille
Écrire ces 3000 variables dans la feuille me prend beaucoup de temps
Existe-t-il un moyen plus rapide de faire cette opération ?

Merci pour votre aide
Bonne soirée
Alf

Bonjour,

A )
Copie la procédure et la fonction dans un "NOUVEAU" module standard.
Dans mon exemple, le nom du module est "MichD". Le but est d'éviter
de lister les variables appartenant Í  ce module. Si tu donnes un autre
nom au module, tu devras adapter son nom dans la procédure.

B ) La procédure tient compte seulement des variables dont le type est
déclaré peut importe leur type.
Dim X as String, y As long ainsi de suite.

C ) Le résultat s'affiche dans la feuille "MichD" créée en début de
procédure.
Toutes les variables dans une même ligne s'affichent dans la même ligne
de la feuille de calcul, mais dans des cellules différentes. Dans chaque
cellule, tu y retrouves le nom de la variable et son type.

D ) Tu as même les lignes de déclaration des procédures ou fonction si
elles contiennent une variable et son type.

D ) La procédure scanne toutes les lignes de tous les modules Í  la
recherche des variables.


'******************************************************************
Sub MesVariables()
Dim Maligne As String
Dim Module As Object, Rechercher As String
Dim B As Long, Trouver As Integer
Dim I As Integer, Sh As Worksheet

On Error Resume Next
Set Sh = Worksheets("MichD")
If Err = 0 Then
Sh.UsedRange.Clear
Else
Set Sh = Worksheets.Add
Sh.Name = "MichD"
End If

Rechercher = "As"

For Each Module In ThisWorkbook.VBProject.VBComponents
With Module.CodeModule
If Module.Name <> "MichD" Then
For I = 1 To .CountOfLines
Trouver = InStr(.Lines(I, 1), Rechercher)
If Trouver > 0 Then
Maligne = Replace(.Lines(I, 1), ",", "")
B = B + 1
T = VarName(Maligne)
Sh.Range("A" & B).Resize(, UBound(T)).Value Application.Transpose(T)
End If
Next I
End If
End With
Next Module
Sh.UsedRange.EntireColumn.AutoFit
Set Module = Nothing
End Sub
'************************************************************
Function VarName(Maligne As String) As Variant
Dim Var As String, B As Long
Dim A As Long, Temp As String
Dim X()
T = Split(Maligne, " ")
For A = 1 To UBound(T)
If UCase(T(A)) = "AS" Then
Temp = Temp & T(A - 1) & " AS " & T(A + 1)
B = B + 1
ReDim Preserve X(1 To B)
X(B) = Temp
Temp = ""
End If
Next
VarName = X
End Function
'************************************************************


MichD

Une petite correction apportée.

Bonjour,

A )
Copie la procédure et la fonction dans un "NOUVEAU" module standard.
Dans mon exemple, le nom du module est "MichD". Le but est d'éviter
de lister les variables appartenant Í  ce module. Si tu donnes un autre
nom au module, tu devras adapter son nom dans la procédure.

B ) La procédure tient compte seulement des variables dont le type est
déclaré peut importe leur type.
Dim X as String, y As long  ainsi de suite.

C ) Le résultat s'affiche dans la feuille "MichD" créée en début de la
procédure. Toutes les variables dans une même ligne s'affichent
dans la même ligne de la feuille de calcul, mais dans des cellules
différentes. Dans chaque cellule, tu y retrouves le nom de la variable
et son type.

D ) Les variables passées comme paramètres dans des lignes de
déclaration des procédures ou fonctions sont omises.

E ) La procédure scanne toutes les lignes de tous les modules Í  la
recherche des variables.


******************************************************************
Sub Remplacer()
Dim Maligne As String
Dim Module As Object, Rechercher As String
Dim B As Long, Trouver As Integer
Dim I As Integer, Sh As Worksheet

On Error Resume Next
Set Sh = Worksheets("MichD")
If Err = 0 Then
Sh.UsedRange.Clear
Else
Set Sh = Worksheets.Add
Sh.Name = "MichD"
End If

Rechercher = "As"

For Each Module In ThisWorkbook.VBProject.VBComponents
With Module.CodeModule
If Module.Name <> "MichD" Then
For I = 1 To .CountOfLines
Trouver = InStr(.Lines(I, 1), Rechercher)
If Trouver > 0 Then
Maligne = Replace(.Lines(I, 1), ",", "")
If InStr(1, Maligne, "(", vbTextCompare) = 0 Then
T = VarName(Maligne)
B = B + 1
Sh.Range("A" & B).Resize(, UBound(T)).Value = T
End If
End If
Next I
End If
End With
Next Module
Sh.UsedRange.EntireColumn.AutoFit
Set Module = Nothing
End Sub
******************************************************************
Function VarName(Maligne As String) As Variant
Dim Var As String, B As Long
Dim A As Long, Temp As String
Dim X()
T = Split(Maligne, " ")
For A = 1 To UBound(T)
If UCase(T(A)) = "AS" Then
Temp = Temp & T(A - 1) & " AS " & T(A + 1)
B = B + 1
ReDim Preserve X(1 To B)
X(B) = Temp
Temp = ""
End If
Next
VarName = X
End Function
******************************************************************

MichD

Le mardi 30 mars 2021 Í  15:50:52 UTC+2, MichD a écrit :

Une petite correction apportée.
Bonjour,

A )
Copie la procédure et la fonction dans un "NOUVEAU" module standard.
Dans mon exemple, le nom du module est "MichD". Le but est d'éviter
de lister les variables appartenant Í  ce module. Si tu donnes un autre
nom au module, tu devras adapter son nom dans la procédure.

B ) La procédure tient compte seulement des variables dont le type est
déclaré peut importe leur type.
Dim X as String, y As long ainsi de suite.
C ) Le résultat s'affiche dans la feuille "MichD" créée en début de la
procédure. Toutes les variables dans une même ligne s'affichent
dans la même ligne de la feuille de calcul, mais dans des cellules
différentes. Dans chaque cellule, tu y retrouves le nom de la variable
et son type.
D ) Les variables passées comme paramètres dans des lignes de
déclaration des procédures ou fonctions sont omises.

E ) La procédure scanne toutes les lignes de tous les modules Í  la
recherche des variables.


******************************************************************
Sub Remplacer()
Dim Maligne As String
Dim Module As Object, Rechercher As String
Dim B As Long, Trouver As Integer
Dim I As Integer, Sh As Worksheet

On Error Resume Next
Set Sh = Worksheets("MichD")
If Err = 0 Then
Sh.UsedRange.Clear
Else
Set Sh = Worksheets.Add
Sh.Name = "MichD"
End If

Rechercher = "As"

For Each Module In ThisWorkbook.VBProject.VBComponents
With Module.CodeModule
If Module.Name <> "MichD" Then
For I = 1 To .CountOfLines
Trouver = InStr(.Lines(I, 1), Rechercher)
If Trouver > 0 Then
Maligne = Replace(.Lines(I, 1), ",", "")
If InStr(1, Maligne, "(", vbTextCompare) = 0 Then
T = VarName(Maligne)
B = B + 1
Sh.Range("A" & B).Resize(, UBound(T)).Value = T
End If
End If
Next I
End If
End With
Next Module
Sh.UsedRange.EntireColumn.AutoFit
Set Module = Nothing
End Sub
******************************************************************
Function VarName(Maligne As String) As Variant
Dim Var As String, B As Long
Dim A As Long, Temp As String
Dim X()
T = Split(Maligne, " ")
For A = 1 To UBound(T)
If UCase(T(A)) = "AS" Then
Temp = Temp & T(A - 1) & " AS " & T(A + 1)
B = B + 1
ReDim Preserve X(1 To B)
X(B) = Temp
Temp = ""
End If
Next
VarName = X
End Function
******************************************************************

MichD

Merci MichD
Réponse tardive mais réponse quand même
Mieux vaut tard....:-)