Problemes d'insertions de colonnes dans un tableau

Version imprimable

09/05/2013, 15h04
Thibaud.L

Problemes d'insertions de colonnes dans un tableau

Bonjour,
j'ai un probleme assez embettant.

Sommairement, j'envoie des donnees dans un tableau, si j'insere une nouvelle colonne j'aimerai que les donnees envoyees suivent leur colonne initiale.

ex :
A1 -> 1
B1 -> 2
si j'ajoute une colonne entre A et B je voudrais avoir :
A1 -> 1
B1 -> rien
C1 -> 2

Pour l'instant, je donne un nom a ma valeur de depart et utilise un offset pour decaler l'insertion de mes valeurs dans mon tableau. Mais avec l'insertion d'une colonne toutes les donnees sont decales.
J'ai pense a donner un nom a chaque cellules, mais j'en ai 250, donc je ne trouve pas ca tres elegant (et ca prend du temps).....

Avez vous une solution, ou des tuyaux a mon probleme.

PS : j'ecrit avec un clavier qwerty, c'est pour cela qu'il n'y a pas d'accents

Thibaud
09/05/2013, 16h56
Invité

Bonjour,

Ce serait plus compréhensible avec le code dans votre message.

Cordialement.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
 
Sub extrait()
 
        If quad = 1 Then
            Address = Range("first_start1").Address
        ElseIf quad = 2 Then
            Address = Range("first_start1").Offset(0, 186).Address
        ElseIf quad = 3 Then
            Address = Range("first_start1").Offset(0, 124).Address
        Else
            Address = Range("first_start1").Offset(0, 62).Address
        End If   ' end f quad=1 if statement
 
 
  Address1 = Left(Address, 2)
  Address1 = Address & ":" & Address1 & "8000"
 
        If Range(Address) = vbNullString Then
           activerow = Range(Address).Address
            Range(Address).Activate
        ElseIf Range(Address).Offset(1, 0) = vbNullString Then
            Range(Address).Offset(1, 0).Select
            activerow = Range(Address).Offset(1, 0).Address
        Else
            Range(Address).Select
            Range(Address).End(xlDown).Offset(1, 0).Select
            activerow = Range(Address).End(xlDown).Offset(1, 0).Address
        End If  ' end of address=22 if statement
 
 
        If (quad = 1) Then
            Range(activerow) = Worksheets("loadflow").Range("Pac_Rect")
            Range(activerow).Offset(0, 1) = Worksheets("loadflow").Range("h24")
            Range(activerow).Offset(0, 4) = Worksheets("loadflow").Range("RECT_load_angle")
            Range(activerow).Offset(0, 7) = Worksheets("loadflow").Range("Uac_Rect")
            Range(activerow).Offset(0, 10) = Worksheets("loadflow").Range("Iac_rect")
            Range(activerow).Offset(0, 13) = Worksheets("loadflow").Range("Pac_Rect") - Worksheets("loadflow").Range("b35") - Worksheets("loadflow").Range("b36")
            Range(activerow).Offset(0, 16) = Worksheets("loadflow").Range("Qac_Rect1")
            Range(activerow).Offset(0, 19) = Worksheets("loadflow").Range("H128")
            Range(activerow).Offset(0, 22) = Worksheets("loadflow").Range("Uval_Rect")
            Range(activerow).Offset(0, 25) = Worksheets("loadflow").Range("Iac_vlv_rect")
            Range(activerow).Offset(0, 28) = Worksheets("loadflow").Range("H129")
            Range(activerow).Offset(0, 31) = Worksheets("loadflow").Range("Conv_Rect")
            Range(activerow).Offset(0, 34) = Worksheets("loadflow").Range("Equi_AC_Vol_LF")
            Range(activerow).Offset(0, 37) = Worksheets("loadflow").Range("Rect_Vlv_RMS")
            Range(activerow).Offset(0, 40) = Worksheets("loadflow").Range("Qvlv_Conv1")
            Range(activerow).Offset(0, 43) = Worksheets("loadflow").Range("H130")
            Range(activerow).Offset(0, 46) = Worksheets("loadflow").Range("Per_Tap_rect")
            Range(activerow).Offset(0, 49) = Worksheets("loadflow").Range("Pdc_Rect")
            Range(activerow).Offset(0, 52) = Worksheets("loadflow").Range("dccurrent_aCt")
            Range(activerow).Offset(0, 55) = Worksheets("loadflow").Range("dcvol_rect")
 
            Range(activerow).Offset(0, 58) = P_qrect_IEC
            Range(activerow).Offset(0, 59) = Worksheets("loadflow").Range("h24")
 
 
 
 
End Sub

Ce n'est pas le code complet (il fait 11M).
La copie des donnes fonctionne.

J'ai 4 quadrants (quad) ou je copis des valeurs qui viennent d'une feuille (loadflow). Comme vous pouvez le voir, j'utilise des Offset. Donc si quelqu'un ajoute une colonne dans Loadflow, toutes mes donnes seront decales.
C'est ici que je bloque.....

09/05/2013, 21h41
_C14_

Bonjour / bonsoir
Je ne suis pas trop fan des Offset et je ne visualise pas trop ce tableau de 250 colonnes dont vous voulez extraire des données, cependant :
1. si le souci est lié à une intervention par un "tiers" qui ajouterai une colonne , vous pouvez poser un verrou,
2. vous pouvez aussi asservir l'extraction en fonction d'un nom de colonne ainsi qlq que soit l'ordre des colonnes vous êtes sur de récupérer les données,
3. vous pouvez aussi passer par des tableaux pour stocker les infos avant de les redistribuer.
Il faudrait voir la construction du fichier Excel, cordialement.

Bonjour,

Je ne vais pas corriger votre code, mais plutôt expliquer la méthode que j'utilise.

J'utilise une table de correspondance des champs associant les deux tableaux. A chaque nom de champ d'un tableau "Quad" par exemple, je luis associe le nom du champ dans le tableau "LoadFlow".

Au lancement du programme, je charge les correspondances dans une matrice à deux dimensions (exemple MatriceCorrespondance(X,Y) où X correspond à un enregistrement comprenant 4 colonnes :

Colonne 0 : NomDuChamp du tableau Quad.
Colonne 1 : Position de la colonne dans le tableau Quad.
Colonne 2 : NomDuChamp dans LoadFlow.
Colonne 3 : Position de la colonne dans le tableau LoadFlow).

La dimension Y de la matrice correspond au nombre d'enregistrements -1 dans le tableau de correspondance.

Dans un premier balayage, je vais chercher la position des colonnes dans chaque tableau et je mets à jour ma matrice.
Si la correspondance existe pour tous les champs, j'enclenche la mise à jour de l'équivalent de votre tableau Quad. Je n'ai donc plus besoin de savoir où sont les colonnes dès lors qu'il n'y a pas homonymie des champs pour un même tableau.

Une mise à jour étant codée de la façon suivante :
Code:

1 2 3 For Y = Lbound(MatriceCorrespondance,2) to Ubound(MatriceCorrespondance,2) ShQuad.Cells(LigneEnCoursQuad,1).Offset(0,MatriceCorrespondance(1,Y))=ShLoadFlow.Cells(LigneEnCoursLoadFlow,1).Offset(0,MatriceCorrespondance(3,Y)) Next Y
Si des colonnes doivent être déplacées dans les tableaux Quad ou LoadFlow, le code suivant permet de réorganiser les tableaux en fonction de l'ordre des enregistrements dans la matrice :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 Sub OrdonnnerLesColonnes() ' Ce programme cherche les colonnes contenues dans la matrice ' et les ordonne dans l'ordre de la matrice Dim ColAOrdonner As Long Dim LigneDeTitre As Long Sheets("XXX").activate ' A adapter selon le feuille à modifier LigneDeTitre = 1 ' A adapter à votre tableau For Y = UBound(MatriceCorrespondance, 2) To 1 Step -1 ColAOrdonner = 0 Call RechercherColonne(LigneDeTitre, MatriceCorrespondance(0, Y)) ' Dans notre exemple MatriceCorrespondance(0, Y) si réordonner colonne Quad, MatriceCorrespondance(2, Y) si LoadFlow If ColAOrdonner > 2 Then Range(Cells(1, ColAOrdonner), Cells(ActiveSheet.Rows.Count, ColAOrdonner)).Select Selection.Cut Range(Cells(1, 2), Cells(ActiveSheet.Rows.Count, 2)).Select Selection.Insert Shift:=xlToRight Cells(1, 1).Select End If Next J End Sub Function RechercherColonne(LigneTitre, TitreRecherche) Dim NbColonnesTitre As Long Dim Cellule As Range RechercherColonne = 0 NbColonnesTitre = Cells(LigneTitre, ActiveSheet.Columns.Count).End(xlToLeft).Column Range(Cells(LigneTitre, 1), Cells(LigneTitre, NbColonnesTitre)).Select For Each Cellule In Selection Select Case Mid(Cellule.Value, 1, Len(TitreRecherche)) Case TitreRecherche RechercherColonne = Cellule.Column Exit For End Select Next If RechercherColonne = 0 Then MessagePresenceVariables = MessagePresenceVariables & Chr(10) & TitreRecherche End If End Function
Pour mieux comprendre, je vous propose de regarder deux messages récents

Pour la table de correspondance, voir le message :
http://www.developpez.net/forums/d13...-insuffisante/

Pour le chargement d'une matrice à deux dimensions :
http://www.developpez.net/forums/d13...-2-dimensions/

Si une colonne doit être ajoutée dans les tableaux Quad, il suffit d'ajouter une ligne dans la feuille de correspondance.

Cordialement.

10/05/2013, 12h19
Thibaud.L

Bonjour, merci d'avoir repondu.
Je vais analyser votre code pour voir si je peux l'inserer quelque part.

Je n'avais pas pense a bloquer la feuille, j'ai demande a mon superieur si je pouvais faire ca. Et sa reponse a ete negative.... ca aurait ete plus facile.
Je n'aime pas trop l'idee d'assigner un nom a chaque colonnes etant donne que j'en ai deja beaucoup.

Je vous tiens au courant de mon avance.

Cordialement

Thibaud