Copie de tableau

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion Flo.
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
F

Flo.

Guest
Bonjour,
J'ai réalisé une application sur Excel que je voudrais optimiser. Pour cela je souhaite utiliser les tableaux VBA au lieux des feuilles utilisées comme tableaux. J'ai réalisé le code suivant :
Code: 
Option Base 0
' Déclaration des variables locales
Dim Mini_ech As Single, D_sp_ech As Double
Dim Mini_adm As Single, D_sp_adm As Double, Ep As Single
Dim Colonne As Integer, Ligne As Integer, Colonne_adm As Integer, Ligne_adm As Integer
Dim Collision_Soupape(89, 150) As Single
[COLOR="Red"]Dim Tab_Tmp_Dsp(40) As Single, Tab_Tmp_Dsp_5S(40) As String[/COLOR]
Dim dy As Single, dx As Single, Ligne_Soup As Integer, Ligne_Dss As Integer
Dim dx_ech As Single, dy_ech As Single, Depe As Single, teta_reel_ech As Single, Dsp_int_ech As Single
Dim dx_adm As Single, dy_adm As Single, Depa As Single, teta_reel_adm As Single, Dsp_int_adm As Single
Dim dx_adm_5S As Single, dy_adm_5S As Single, Depa_5S As Single, teta_reel_adm_5S As Single, Dsp_int_adm_5S As Single
Dim alpha As Single, Ex As Single, Ez As Single
Dim x_ech As Single, x_adm As Single, z_ech As Single, z_adm As Single
Dim Ligne_Min_adm As Integer, Ligne_Min_ech As Integer, Nb_Lignes_alpha As Integer
Dim Min As Single, Alpha_min As Single, Alpha_max As Single, Beta As Single, Ex_ell As Single

Sub Collision...()
        Application.ScreenUpdating = False
        
        With Worksheets("Calculs")
            ' Importation des valeurs dans le classeur
            Depe = .Range("Depe").Value
            Depa = .Range("Depa").Value
            Ep = .Range("Ep").Value
            teta_echappement = Application.WorksheetFunction.Radians(.Range("teta_e").Value)
            teta_admission = Application.WorksheetFunction.Radians(.Range("teta_a").Value)
                    
            For i = 3 To 43
                dx_ech = .Cells(i, 11).Value + Depe * Sin(teta_echappement) - Ep
                dy_ech = .Cells(i, 12).Value - (.Cells(i, 8).Value + Depe * Cos(teta_echappement))
                Dsp_int_ech = Sqr(dx_ech ^ 2 + dy_ech ^ 2)
                If dx_ech < 0 And dy_ech > 0 Then
                    If Application.WorksheetFunction.Acos(Abs(dy_ech / Dsp_int_ech)) > teta_echappement Then
                        teta_reel_ech = Application.WorksheetFunction.Acos(Abs(dy_ech / Dsp_int_ech)) - teta_echappement
                        D_sp_ech = Dsp_int_ech * Cos(teta_reel_ech)
                    Else
                        teta_reel_ech = teta_echappement - Application.WorksheetFunction.Acos(Abs(dy_ech / Dsp_int_ech))
                        D_sp_ech = Dsp_int_ech * Cos(teta_reel_ech)
                    End If
                ElseIf dx_ech > 0 And dy_ech < 0 Then
                    If Application.WorksheetFunction.Acos(Abs(dy_ech / Dsp_int_ech)) > teta_echappement Then
                        teta_reel_ech = Application.WorksheetFunction.Acos(Abs(dy_ech / Dsp_int_ech)) - teta_echappement
                        D_sp_ech = -Dsp_int_ech * Cos(teta_reel_ech)
                    Else
                        teta_reel_ech = teta_echappement - Application.WorksheetFunction.Acos(Abs(dy_ech / Dsp_int_ech))
                        D_sp_ech = -Dsp_int_ech * Cos(teta_reel_ech)
                    End If
                ElseIf dx_ech > 0 And dy_ech > 0 Then
                    If Application.WorksheetFunction.Acos(Abs(dx_ech / Dsp_int_ech)) > teta_echappement Then
                        teta_reel_ech = teta_echappement + Application.WorksheetFunction.Acos(Abs(dy_ech / Dsp_int_ech))
                        D_sp_ech = Dsp_int_ech * Cos(teta_reel_ech)
                    Else
                        teta_reel_ech = Pi / 2 - teta_echappement + Application.WorksheetFunction.Acos(Abs(dx_ech / Dsp_int_ech))
                        D_sp_ech = -Dsp_int_ech * Cos(teta_reel_ech)
                    End If
                ElseIf dx_ech < 0 And dy_ech < 0 Then
                    If Application.WorksheetFunction.Acos(Abs(dx_ech / Dsp_int_ech)) > teta_echappement Then
                        teta_reel_ech = teta_echappement + Application.WorksheetFunction.Acos(Abs(dy_ech / Dsp_int_ech))
                        D_sp_ech = -Dsp_int_ech * Cos(teta_reel_ech)
                    Else
                        teta_reel_ech = Pi / 2 - teta_echappement + Application.WorksheetFunction.Acos(Abs(dx_ech / Dsp_int_ech))
                        D_sp_ech = Dsp_int_ech * Cos(teta_reel_ech)
                    End If
                End If
                Tab_Tmp_Dsp(i - 3) = D_sp_ech
            Next i
            [COLOR="red"]Worksheets("Récapitulatif_Collisions").Range("Res_Dsp_ech").Value = Tab_Tmp_Dsp[/COLOR]
            Worksheets("Calage_Resume").Range("Min_Dsp_ech").Value = Application.WorksheetFunction.Min(Tab_Tmp_Dsp)
        
            For i = 3 To 43
                dx_adm = .Cells(i, 9).Value - Depa * Sin(teta_admission) - Ep
                dy_adm = .Cells(i, 10).Value - (.Cells(i, 8).Value + Depa * Cos(teta_admission))
                Dsp_int_adm = Sqr(dx_adm ^ 2 + dy_adm ^ 2)
                If dx_adm < 0 And dy_adm > 0 Then
                    ' Cadran 4 Partie 2
                    If Application.WorksheetFunction.Acos(Abs(dx_adm / Dsp_int_adm)) > teta_admission Then
                          teta_reel_adm = teta_admission + Application.WorksheetFunction.Acos(Abs(dy_adm / Dsp_int_adm))
                          D_sp_adm = Dsp_int_adm * Cos(teta_reel_adm)
                      ' Cadran 4 Partie 1
                      Else
                          teta_reel_adm = Pi / 2 - teta_admission + Application.WorksheetFunction.Acos(Abs(dx_adm / Dsp_int_adm))
                          D_sp_adm = -Dsp_int_adm * Cos(teta_reel_adm)
                      End If
                  ElseIf dx_adm > 0 And dy_adm < 0 Then
                      ' Cadran 2 Partie 1
                      If Application.WorksheetFunction.Acos(Abs(dx_adm / Dsp_int_adm)) > teta_admission Then
                          teta_reel_adm = teta_admission + Application.WorksheetFunction.Acos(Abs(dy_adm / Dsp_int_adm))
                          D_sp_adm = -Dsp_int_adm * Cos(teta_reel_adm)
                      ' Cadran 2 Partie 2
                      Else
                          teta_reel_adm = Pi / 2 - teta_admission + Application.WorksheetFunction.Acos(Abs(dx_adm / Dsp_int_adm))
                          D_sp_adm = Dsp_int_adm * Cos(teta_reel_adm)
                      End If
                  ElseIf dx_adm > 0 And dy_adm > 0 Then
                      ' Cadran 3 Partie 1
                      If Application.WorksheetFunction.Acos(Abs(dy_adm / Dsp_int_adm)) > teta_admission Then
                          teta_reel_adm = Application.WorksheetFunction.Acos(Abs(dy_adm / Dsp_int_adm)) - teta_admission
                          D_sp_adm = Dsp_int_adm * Cos(teta_reel_adm)
                      ' Cadran 3 Partie 2
                      Else
                          teta_reel_adm = teta_admission - Application.WorksheetFunction.Acos(Abs(dy_adm / Dsp_int_adm))
                          D_sp_adm = Dsp_int_adm * Cos(teta_reel_adm)
                      End If
                  ElseIf dx_adm < 0 And dy_adm < 0 Then
                      ' Cadran 1 Partie 1
                      If Application.WorksheetFunction.Acos(Abs(dy_adm / Dsp_int_adm)) > teta_admission Then
                          teta_reel_adm = Application.WorksheetFunction.Acos(Abs(dy_adm / Dsp_int_adm)) - teta_admission
                          D_sp_adm = -Dsp_int_adm * Cos(teta_reel_adm)
                      ' Cadran 1 Partie 2
                      Else
                          teta_reel_adm = teta_admission - Application.WorksheetFunction.Acos(Abs(dy_adm / Dsp_int_adm))
                          D_sp_adm = -Dsp_int_adm * Cos(teta_reel_adm)
                      End If
                  End If
                  Tab_Tmp_Dsp(i - 3) = D_sp_adm
              Next i
                Worksheets("Récapitulatif_Collisions").Range("Res_Dsp_adm").Value = Tab_Tmp_Dsp
              Worksheets("Calage_Resume").Range("Min_Dsp_adm").Value = Application.WorksheetFunction.Min(Tab_Tmp_Dsp)
              
              If Five_Valves = True Then
                  Depa_5S = .Range("Depa_5S").Value
                  teta_admission_5S = Application.WorksheetFunction.Radians(.Range("teta_a_5S").Value)
                  For i = 3 To 43
                      dx_adm_5S = .Cells(i, 13).Value - Depa_5S * Sin(teta_admission_5S) - Ep
                      dy_adm_5S = .Cells(i, 14).Value - _
                          (.Cells(i, 8).Value + Depa_5S * Cos(teta_admission_5S))
                      Dsp_int_adm_5S = Sqr(dx_adm_5S ^ 2 + dy_adm_5S ^ 2)
                      If dx_adm_5S < 0 And dy_adm_5S > 0 Then
                          If Application.WorksheetFunction.Acos(Abs(dx_adm_5S / Dsp_int_adm_5S)) > teta_admission_5S Then
                              teta_reel_adm_5S = teta_admission_5S + Application.WorksheetFunction.Acos(Abs(dy_adm_5S / Dsp_int_adm_5S))
                              D_sp_adm_5S = Dsp_int_adm_5S * Cos(teta_reel_adm_5S)
                          Else
                              teta_reel_adm_5S = Pi / 2 - teta_admission_5S + _
                                  Application.WorksheetFunction.Acos(Abs(dx_adm_5S / Dsp_int_adm_5S))
                              D_sp_adm_5S = -Dsp_int_adm_5S * Cos(teta_reel_adm_5S)
                          End If
                      ElseIf dx_adm_5S > 0 And dy_adm_5S < 0 Then
                          If Application.WorksheetFunction.Acos(Abs(dx_adm_5S / Dsp_int_adm_5S)) > teta_admission_5S Then
                              teta_reel_adm_5S = teta_admission_5S + Application.WorksheetFunction.Acos(Abs(dy_adm_5S / Dsp_int_adm_5S))
                              D_sp_adm_5S = -Dsp_int_adm_5S * Cos(teta_reel_adm_5S)
                          Else
                              teta_reel_adm_5S = Pi / 2 - teta_admission_5S + _
                                  Application.WorksheetFunction.Acos(Abs(dx_adm_5S / Dsp_int_adm_5S))
                              D_sp_adm_5S = Dsp_int_adm_5S * Cos(teta_reel_adm_5S)
                          End If
                      ElseIf dx_adm_5S > 0 And dy_adm_5S > 0 Then
                          If Application.WorksheetFunction.Acos(Abs(dy_adm_5S / Dsp_int_adm_5S)) > teta_admission_5S Then
                              teta_reel_adm_5S = Application.WorksheetFunction.Acos(Abs(dy_adm_5S / Dsp_int_adm_5S)) - teta_admission_5S
                              D_sp_adm_5S = Dsp_int_adm_5S * Cos(teta_reel_adm_5S)
                          Else
                              teta_reel_adm_5S = teta_admission_5S - Application.WorksheetFunction.Acos(Abs(dy_adm_5S / Dsp_int_adm_5S))
                              D_sp_adm_5S = Dsp_int_adm_5S * Cos(teta_reel_adm_5S)
                          End If
                      ElseIf dx_adm_5S < 0 And dy_adm_5S < 0 Then
                          If Application.WorksheetFunction.Acos(Abs(dy_adm_5S / Dsp_int_adm_5S)) > teta_admission_5S Then
                              teta_reel_adm_5S = Application.WorksheetFunction.Acos(Abs(dy_adm_5S / Dsp_int_adm_5S)) - teta_admission_5S
                              D_sp_adm_5S = -Dsp_int_adm_5S * Cos(teta_reel_adm_5S)
                          Else
                              teta_reel_adm_5S = teta_admission_5S - Application.WorksheetFunction.Acos(Abs(dy_adm_5S / Dsp_int_adm_5S))
                              D_sp_adm_5S = -Dsp_int_adm_5S * Cos(teta_reel_adm_5S)
                          End If
                      End If
                      Tab_Tmp_Dsp(i - 3) = D_sp_adm_5S
                  Next i
                  Worksheets("Récapitulatif_Collisions").Range("Res_Dsp_adm_5S").Value = Tab_Tmp_Dsp
                  Worksheets("Calage_Resume").Range("Min_Dsp_adm_5S").Value = Application.WorksheetFunction.Min(Tab_Tmp_Dsp)
              Else
                  For i = 0 To 40
                        Tab_Tmp_Dsp_5S(i) = "N.R"
                  Next i
                  Worksheets("Récapitulatif_Collisions").Range("Res_Dsp_adm_5S") = Tab_Tmp_Dsp_5S
                  Worksheets("Calage_Resume").Range("Min_Dsp_adm_5S").Value = "N.R"
              End If
        End With
End Sub

Le problème c'est que lorsque je l'utilise, il ne rentre pas toutes les valeurs dans la plage demandé sur excel mais seulement la valeur contenue dans la première case mémoire de mon tableau (Tab_Tmp_Dsp(0)).
J'ai cherché sur internet et n'ai pas trouvé ce qu'il se passe. J'ai trouvé des pages pour optimiser dans laquelle il disait que l'utilisation des feuilles était plus longue que celle d'un tableau VBA (Acclration du code VBA).

Quelqu'un serait il me dire d'où vient mon problème?
Merci d'avance
 
Dernière modification par un modérateur:
Trier par date Trier par votes
Re : Copie de tableau

Ca fait peut être beaucoup tout le code... Voici ce que ça donne de manière simplifiée :

Code: 
Option Base 0
' Déclaration des variables locales
[COLOR="Red"][B]Dim Tab_Tmp_Dsp(40) As Single, Tab_Tmp_Dsp_5S(40) As String[/B][/COLOR]


Sub Collision...()
        Application.ScreenUpdating = False
        
            ' Importation des valeurs dans le classeur
                    
            For i = 3 To 43
		' Réalisation des calculs
		' Mise en mémoire du résultat
                Tab_Tmp_Dsp(i - 3) = D_sp_ech
            Next i
	    ' Affichage des résultats dans une plage
            [COLOR="red"][B]Application.Worksheets("Récapitulatif_Collisions").Range("Res_Dsp_ech").Value = Tab_Tmp_Dsp[/B][/COLOR]
	    ' Recherche de la valeur min
            Worksheets("Calage_Resume").Range("Min_Dsp_ech").Value = Application.WorksheetFunction.Min(Tab_Tmp_Dsp)
End Sub

J'ai oublié de préciser que la plage dans Excel (Res_Dsp_ech) fait la même taille que le tableau déclaré.
 
Dernière modification par un modérateur:
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

P
  • Résolu(e)
Microsoft 365 VBA - Survol d'un Label déclenchement action
Réponses
8
Affichages
325
patricko-13
P
N
  • Question Question
Microsoft 365 gestion de kilometrage
Réponses
4
Affichages
470
nabilexcel2007
N
F
  • Question Question
Autres Listbox-transfère la recherche dans une ListBox vers une feuille de calcul
2
Réponses
18
Affichages
517
dysorthographie
dysorthographie
U
  • Question Question
Autres [RÉSOLU] macro à modifier
Réponses
1
Affichages
616
un internaute
U
F
  • Question Question
Microsoft 365 Problème mémoire insuffisante
Réponses
5
Affichages
904
TooFatBoy
TooFatBoy
deudecos
  • Résolu(e)
XL pour MAC Code vba pour recherche sur une seule ligne
Réponses
4
Affichages
178
deudecos
deudecos
pascal21
  • Question Question
XL 2016 intégrer une macro sur les nouvelles feuilles crées
Réponses
6
Affichages
220
pascal21
pascal21
treza88
  • Résolu(e)
XL 2021 Problème réaffectation variable Objet
Réponses
2
Affichages
230
treza88
treza88
anthoYS
  • Résolu(e)
XL 2019 Comment modifier ces codes VB de sorte que le clic droit sur un commentaire présent, permette l'édition et non cette erreur (capture) ?
Réponses
6
Affichages
249
anthoYS
anthoYS
V
  • Question Question
XL 2021 Mon codage ne fonctionne pas il devrais créer un numero automatique
Réponses
8
Affichages
272
Valtrase
Valtrase
anthoYS
  • Résolu(e)
XL 2019 Adapter ce code, et améliorer le tableau avec graphique à l'année à y insérer ?
Réponses
4
Affichages
476
sylvanu
sylvanu
treza88
  • Question Question
XL 2021 La méthode union de l'objet '_Global' a échoué
Réponses
10
Affichages
334
sousou
sousou
F
  • Question Question
XL 2021 probleme dans la macro
Réponses
4
Affichages
728
kiki29
kiki29
X
  • Question Question
Microsoft 365 compte à rebours avec application.OnTime (Résolu)
Réponses
9
Affichages
349
xabino
X
Y
  • Résolu(e)
XL 2019 Compter le nb de Fichier dans un dossier afin de créer une nouvelle version
Réponses
2
Affichages
539
youguybass
Y
anthoYS
  • Résolu(e)
XL 2019 Insérer un commentaire prêt à saisir de B à X sans limite... (excepté en ligne 1 ; taille de commentaire Ok déjà voir code VB en B*)
Réponses
7
Affichages
263
Nicolas JACQUIN
Nicolas JACQUIN
A
  • Question Question
XL 2010 Filtrer un Combobox en VBA excel
2 3
Réponses
43
Affichages
3 K
Dranreb
Dranreb
patricktoulon
  • Question Question
Microsoft 365 datepicker dynamique intra userform ou dans feuille 2 versions(frame dynamique)(toute version d'excel )
6 7 8
Réponses
105
Affichages
5 K
Usine à gaz
Usine à gaz
Nicolas JACQUIN
  • Question Question
XL 2019 Gérer la descente d'une cellule colorer selon un timer
2 3 4
Réponses
56
Affichages
3 K
Rheeem
R
treza88
  • Question Question
XL 2021 Erreur "l'indice n'appartient à la selection"
Réponses
10
Affichages
737
treza88
treza88
Retour