transposer sous conditions de nom d'horaire de texte en boucle

**bouboun76** · 27/08/2015, 06h58

bonjour,
aider moi la je seche
je voudrais transposer sur une ligne entre K2 et T2 les positions colonne G des agents en fonction de leurs 'nom colonne J par rapport à une liste d'agent colonne A, 'horaire colonne F, et 'position colonne G en vba
sur cellule de 2 à 500

merci pour votre aide
fichier joint

**vinc_bilb** · 27/08/2015, 09h50

Bonjour,

Vous avez commencé à écrire du code? Un exemple sur 1 cas aiderait à comprendre vos attentes, avez-vous regardé des solutions classiques telles que TCD?
Ce n'est pas vraiment dans les usages du forum de fournir des solutions clés en mains, je pense

**bouboun76** · 27/08/2015, 19h41

bonjour,
super, merci pour les discutions similaires
j'ai trouvé ce code qui correspond à l'une de mes attentes
j'aimerais maintenant que chaque colonne B contienne que les N1,la C les N2 .....jusqu'à N5
je cherche de mon coté

merci encore

**vinc_bilb** · 28/08/2015, 10h58

Bonjour,

Voir le code ci-dessous, testé

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub Copy_Col()
 
Dim InpRng As Range
Dim CatInd As Integer, ColOffs As Integer, RowN As Integer
Dim LabSplit As Variant
 
'Init
    ColOffs = 2
 
    Set InpRng = ThisWorkbook.Worksheets("Feuil1").Range("A1").CurrentRegion    'On définit le range de départ
    Debug.Print InpRng.AddressLocal
 
' On parcout la colonne B et on écrit dans les suivantes suivant les valeurs trouvées
 
    For RowN = 1 To InpRng.Rows.Count
 
        If InpRng(RowN, ColOffs).Value Like "N# *" = True Then  'Cellule commencant par 'N(0-9) '
 
            LabSplit = Split(InpRng(RowN, ColOffs), " ", , vbTextCompare)(0) 'On Split sur l'espace
            CatInd = CInt(Right(LabSplit, Len(LabSplit) - 1))                        'On récupère la valeur après le N pour recalculer la colonne après
            InpRng(RowN, ColOffs + CatInd) = InpRng(RowN, 1)
 
        End If
 
    Next RowN
 
End Sub

**bouboun76** · 28/08/2015, 15h43

bonjour,
et merci vinc_bilb de se pencher sur mon cas qui dépasse maintenant largement mes compétences
j'ai inséré et adapté ton code et rien ne bouge
je t'exprime ma logique auquel je n'arrive pas à coder en VBA

pour une colonne de 2 to 200
si cellule vide (exemple en G6)verifier si les cellules cette ligne (exemple entre G2 ET G5)contiennent une partie du texte (dans mon cas like" N#")
si oui couper et coller dans cette case vide
et on continue
du cou après moi je peux adapter ça par colonne de mes codes

**vinc_bilb** · 28/08/2015, 16h32

Lots in the dark.... ou le syndrome du vendredi

j'ai inséré et adapté ton code et rien ne bouge

=> Ah! ça fait quelque chose chez moi sur les colonnes C à J

Pourriez-vous compléter votre exemple avec sur quelques cas, une vue de ce que vous attendez comme résultat? Si possible avec une couleur dédiée?

**bouboun76** · 28/08/2015, 19h04

effectivement rien ne bouge chez moi bizarre

voici dans partie verte ce que j'obtiens quand j'actionne mon bouton et dans la partie grise ce que je voudrais

cordialement

**vinc_bilb** · 31/08/2015, 13h30

Bonjour,

Il y aurait plus efficace et rapide que la solution que je vous propose dessous, en passant par des tableaux ou un dictionnaire, mais c'est moins lisible. Le code dessous considère que les catégories N1..N5 ne sont pas figées et que demain, vous pouvez rajouter N6, N7.... sans retoucher le code. Si c'est figé, vous pouvez le raccourcir (voir CatInd, CatMax)

Vous pouvez mettre ce code pour essai dans votre macro Private Sub CommandButton1_Click(), en supprimant le code précédent
Testé

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
60
61
62
63
Sub Test_VB()
 
Dim DataTabAR() As Variant
Dim InpRng As Range
Dim ColN As Integer, RowN As Integer, DataTabRowN As Integer, RowOffs As Integer
Dim CatInd As Integer, CatMax As Integer
Dim LabSplit As Variant
 
' Initialisation
    Set InpRng = ThisWorkbook.Worksheets("Feuil1").Range("A1").CurrentRegion    'On définit le range de départ
    Debug.Print InpRng.AddressLocal
 
    ReDim DataTabAR(1 To InpRng.Rows.Count, 1 To InpRng.Rows.Count)
 
' On S'assure que les données d'entrée sont bien triées: ça peut être enlevé si c'est nativement le cas
    With InpRng.Worksheet.AutoFilter.Sort
        .SortFields.Clear
        .SortFields.Add Key:=InpRng.Columns(1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=InpRng.Columns(2), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
 
 
' On lit le nom des agents 
    ColN = 1
    DataTabRowN = 1
    RowOffs = InpRng.Rows.Count + 2
    DataTabColN = 1
 
    For RowN = 2 To InpRng.Rows.Count
 
        If InpRng(RowN, ColN + 1).Value Like "N# *" = True Then                 'Cellule commencant par 'N(0-9) '
 
            If InpRng(RowN, ColN).Value <> InpRng(RowN - 1, ColN).Value Then DataTabRowN = DataTabRowN + 1 'si c'est le même nom, on reste sur la même ligne autrement saut
 
            LabSplit = Split(InpRng(RowN, ColN + 1), " ", , vbTextCompare)(0)   'On Split sur l'espace
            CatInd = CInt(Right(LabSplit, Len(LabSplit) - 1))                   'On récupère la valeur après le N pour recalculer la colonne après
            If CatInd > CatMax Then CatMax = CatInd
 
        ' On écrit dessous
            InpRng(DataTabRowN + RowOffs, ColN) = InpRng(RowN, ColN)
            InpRng(DataTabRowN, ColN + CatInd) = InpRng(RowN, ColN + 1)
 
        End If
 
    Next RowN
 
        ' On écrit les titres
    InpRng(RowOffs, ColN) = InpRng(1, ColN)
 
    For ColN = 1 To CatMax
 
        InpRng(RowOffs, ColN + 1) = "N" & ColN
    Next ColN
 
        ' On peut effacer le range source
    'InpRng.Clear
 
End Sub

**bouboun76** · 01/09/2015, 01h59

bonjour,

et félicitation pour l'avancée, pour ma part je frise la rupture d'anévrisme
j'ai bien remplacé par votre nouveau code
les colonnes 3 à 5 fonctionnent super bien
le souci c'est sur les 2 premières colonnes qui contiennent les données à traiter
encore merci au temps que vous me consacrez

cordialement

**vinc_bilb** · 01/09/2015, 11h43

Bonjour,

La rupture d'anévrisme? Oh, c'est un bon signe ....

Ci-dessous le code corrigé / simplifié avec l'ajout de la confirmation de l'effacement des données d'entrée

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Private Sub CommandButton1_Click()
 
Dim InpRng As Range
Dim ColN As Integer, RowN As Integer, DataTabRowN As Integer, RowOffs As Integer
Dim CatInd As Integer, CatMax As Integer
Dim LabSplit As Variant, MsgAnswer As String
 
' Initialisation
    Set InpRng = ThisWorkbook.Worksheets("Feuil1").Range("A2").CurrentRegion    'On définit le range de départ
    Debug.Print InpRng.AddressLocal
 
' On lit le nom des agents
    ColN = 1
    DataTabRowN = 1
    RowOffs = InpRng.Rows.Count
 
    For RowN = 2 To InpRng.Rows.Count
 
        If InpRng(RowN, ColN + 1).Value Like "N# *" = True Then                 'Cellule commencant par 'N(0-9) '
 
            If InpRng(RowN, ColN).Value <> InpRng(RowN - 1, ColN).Value Then DataTabRowN = DataTabRowN + 1 'si c'est le même nom, on reste sur la même ligne autrement saut
 
            LabSplit = Split(InpRng(RowN, ColN + 1), " ", , vbTextCompare)(0)   'On Split sur l'espace
            CatInd = CInt(Right(LabSplit, Len(LabSplit) - 1))                   'On récupère la valeur après le N pour recalculer la colonne après
            If CatInd > CatMax Then CatMax = CatInd
 
        ' On écrit dessous
            InpRng(DataTabRowN + RowOffs, ColN) = InpRng(RowN, ColN)
            InpRng(DataTabRowN + RowOffs, ColN + CatInd) = InpRng(RowN, ColN + 1)
 
        End If
 
    Next RowN
 
        ' On écrit les titres du style "Nx"
    For ColN = 1 To CatMax
 
        InpRng(1, ColN + 1) = "N" & ColN
 
    Next ColN
 
        ' On peut effacer le range source
    MsgAnswer = MsgBox("Voulez-vous effacer les données d'origine en " & InpRng.Offset(1, 0).AddressLocal & "?", vbYesNo, "CommandButton1_Click")
    Debug.Print InpRng.Offset(1, 0).AddressLocal
 
    If MsgAnswer = vbYes Then InpRng.Offset(1, 0).EntireRow.Delete
 
 
End Sub

**bouboun76** · 02/09/2015, 15h20

bonjour,
je me répète mais un grand merci pour avoir pris de votre temps pour dépatouiller mon projet
je pensais vraiment que ça aurait été plus simple lol
est ce que vous connaissez un ouvrage qui traite simplement le vba
pour comprendre la logique des variables progressivement ?

**vinc_bilb** · 02/09/2015, 15h46

Bonjour,

VBA est un vrai language, et certaines approches sont moins lisibles au début mais beaucoup plus efficace. Personnellement, ma bible a été
http://bidou.developpez.com/article/VBA/

Bonne continuation

**bouboun76** · 18/04/2016, 19h22

Bonjour,
je me heurte à un problème au rangement des données
en effet quand j'appuie sur le bouton, les "N0" en jaune sur le fichier joint disparaissent
j'ai essayé dans tous les sens mais rien à faire, j'ai juste réussi pour les intitulés en gras

merci pour votre aide

transposer sous conditions de nom d'horaire de texte en boucle [XL-2007]

Excel

Discussions similaires

Partager

Partager