Sujet Précédent Sujet Suivant

[Déplacé VB6 --> VBA] probleme de comprehension

kromei Messages postés 27 Date d'inscription dimanche 13 janvier 2008 Statut Membre Dernière intervention 19 juillet 2010 - 20 avril 2010 à 15:10
kromei Messages postés 27 Date d'inscription dimanche 13 janvier 2008 Statut Membre Dernière intervention 19 juillet 2010 - 20 avril 2010 à 15:38
voila j ai ce code , une partie est faites par moi , une autre est reprise de mon predecesseur
le but est de selectionner à partir d une feuille des données choisies et de les mettre sur la feuille synthese et j y arrives à un detail pres
à la base certains calculs s effectuaient sur une autre feuille entre autre un calcul qui reunit les memes os pour en faire la somme du nombre d heure et chez moi j arrives à tout avoir sauf cette somme dans la bonne page au bon endroit mais donc avec les os en double; quelqu'un pourrait il me lire ce code et me dire ce qui gene vraiment ? mon but final serait d enlever la feuil2 intermediaire pour tout faire sur la feuille synthese 


Private Sub CommandButton19_Click()
Dim c As Range
Dim tablo(), tablo2()
Dim i As Integer, j As Integer, H_Total As Long
Dim temp As String
Dim present As Boolean
    
        UserForm1.MousePointer = fmMousePointerHourGlass
        
        'on se place dans le module 1 du multipointage
        Windows(Module1.Nom_Fichier).Activate
        'on selectionne la feuille 2
        Sheets("Feuil2").Select
        'on efface le contenu des colonnes de A à D
        Columns("A:D").Delete
        'on selectionne A1
        Range("A1").Select
        'on se place dans Feuil1
        Sheets("Feuil1").Select
        'on selectionne C2
        Range("C2").Select
        'pour k de 0 au nombre de sca selectionné
        Sheets("Synthèse pointages").Select
                    Range("A6").Select
        For k = 0 To SCA_Choix.ListCount - 1
        'on se place à la C2 du rapport1 de 1013
           Sheets("Feuil1").Select
            Range("C2").Select
            'faire jusqu a ce que la cellule selectionnée soit vide
            Do Until ActiveCell.Value = ""
            'si la cellule selectionnée est egale a la sca en cours de selection
               If ActiveCell.Value = SCA_Choix.List(k) Then
               'os reçoit la valeur de la cellule 2 fois a droite par rapport à la cellule active
                    OS = ActiveCell.Offset(0, 2).Value
                    LIBOS = ActiveCell.Offset(0, 3).Value
                    NOS = ActiveCell.Offset(0, 8).Value
                    'on selectionne Feuil2
                    Sheets("Synthèse pointages").Select
                    'la cellule reçoit la k ieme valeur de la liste de choix SCA
                    'ActiveCell.Value = SCA_Choix.List(k)
                    'la celule une fois a droite reçoit os la deuxieme reçoit libos et la troisieme reçoit nos
                    ActiveCell.Offset(0, 1).Value = OS
                    ActiveCell.Offset(0, 2).Value = LIBOS
                    ActiveCell.Offset(0, 3).Value = NOS
                    'on selectionne une case vers le bas de la celulle active
                    ActiveCell.Offset(1, 0).Select
                    Sheets("Feuil1").Select
                    
               End If
               'on selectionne une case vers le bas de la cellule selectionnée avant
            ActiveCell.Offset(1, 0).Select
            Loop
        Next
            
        'on selectionne Feuil2
        Sheets("Feuil2").Select
        'on se place à la B2 de multipointage
        Range("B2").Select
        'reDéfinit la taille du tableau et efface le contenu de celui ci
        ReDim tablo(1 To 1)
        'la seule case du tableau reçoit la cellule(2,2)
        tablo(1) = Cells(2, 2)
        'pour chaque c dans la feuil2 de B2 à B...
        For Each c In Sheets("Feuil2").Range("B2:B" & Range("b65536").End(xlUp).Row)
        'present reçoit false , pour i de 1 jusqu a l indice maximal du tableau
            present = False
            For i = 1 To UBound(tablo)
                If tablo(i) c Then present True
            Next i
            If Not present Then
            'redimensionne le tableau en ajoutant une "case" et en gardant son ancien contenu
                ReDim Preserve tablo(1 To UBound(tablo) + 1)
                'l indice maximal du tableau reçoit c
                tablo(UBound(tablo)) = c
            End If
        Next c
        'la liste des ca reçoit les valeurs du tableau
        CA_Liste.List = tablo
        
        Sheets("Feuil2").Select
        Range("E1").Select
        'pour i de 1 à max indice
        For i = 1 To UBound(tablo)
        'la cellule active reçoit le ieme element du tableau
            'ActiveCell.Value = tablo(i)
            'on descend d une case
            ActiveCell.Offset(1, 0).Select
        Next
        'on se place sur E1
        Range("E1").Select
        'faire jusqu a ce que la cellule active soit vide
        Do Until ActiveCell.Value = ""
       ' r reçoit la ligne de la cellule active
            r = ActiveCell.Row
            'valeur reçoit la valeur de ka cellule active
            Valeur = ActiveCell.Value
             'on se place sur B2
            Range("B2").Select
            
            Somme = 0
            Do Until ActiveCell.Value = ""
            'si la cellule active est egale à valeur alors somme reçoit somme + la valeur de la cellule decalé 2 fois à droite par rapport à la cellule selectionnée
            If ActiveCell.Value Valeur Then Somme Somme + ActiveCell.Offset(0, 2).Value
            'on descend d une case
            ActiveCell.Offset(1, 0).Select
            Loop
            'on se place sur la rieme ligne en 5ieme colonne
        Cells(r, 5).Select
        'la cellule reçoit somme
        ActiveCell.Offset(0, 2).Value = Somme
        ' on descend
        ActiveCell.Offset(1, 0).Select
        Loop
        'on efface le contenu des colonnes de A à D
        Columns("A:D").Delete
        'on selectionne les colonnes A à B
        Columns("A:B").Select
        'on trie la selection par rapport à B1 dans l ordre descendant ...
        Selection.Sort Key1:=Range("B1"), Order1:=xlDescending, Header:=xlGuess, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
        
        
        Range("A1").Value = "Code OS"
        Range("B1").Value = "libéllé"
        Range("C1").Value = "Heure(s) dépensée(s) sur l'OS"
        
        
        UserForm1.MousePointer = fmMousePointerDefault
        
        'on selectionne les colonnes de A à D
    Columns("A:D").Select
   ' on fais un trie par rapport à A1
    Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    

    End
End Sub

1 réponse

Réponse 1 / 1
kromei Messages postés 27 Date d'inscription dimanche 13 janvier 2008 Statut Membre Dernière intervention 19 juillet 2010
20 avril 2010 à 15:38
voici la v1 qui copie sur un autre fichier( grace a la macro ajout classeur a la fin qui n effectue aucun calcul)
Private Sub CommandButton2_Click()
Dim c As Range
Dim tablo(), tablo2()
Dim i As Integer, j As Integer, H_Total As Long
Dim temp As String
Dim present As Boolean
If Nb_OS_Limite.Value "TOUS" Then Nb_OS_Limite 1000
    If Not IsNumeric(Nb_Heure.Text) Then
    MsgBox ("Valeur numérique demandée dans le champ Nombre d'heure")
    Else
    If Nb_OS_Limite.Value "" Or Choix_Semaine.Value "" Or Nb_Heure.Value = "" Or SCA_Choix.ListCount = 0 Then
    MsgBox ("Veuillez remplir tous les champs")
    Else
    
    
    
        UserForm1.MousePointer = fmMousePointerHourGlass
        
        Windows(Module1.Nom_Fichier).Activate
        Sheets("Feuil1").Select
        Range("A1").Select
        
        Windows(Module1.Nom_Extract).Activate
        Sheets("Rapport 1").Select
        Range("C2").Select
        For k = 0 To SCA_Choix.ListCount - 1
            Windows(Module1.Nom_Extract).Activate
            Sheets("Rapport 1").Select
            Range("C2").Select
            Do Until ActiveCell.Value = ""
                If ActiveCell.Value SCA_Choix.List(k) And ActiveCell.Offset(0, 6).Value Choix_Semaine.Value Then
                    OS = ActiveCell.Offset(0, 2).Value
                    NOS = ActiveCell.Offset(0, 8).Value
                    Windows(Module1.Nom_Fichier).Activate
                    Sheets("Feuil1").Select
                    ActiveCell.Offset(1, 0).Select
                    ActiveCell.Value = SCA_Choix.List(k)
                    ActiveCell.Offset(0, 1).Value = OS
                    ActiveCell.Offset(0, 2).Value = NOS
                    Windows(Module1.Nom_Extract).Activate
                    Sheets("Rapport 1").Select
                End If
            ActiveCell.Offset(1, 0).Select
            Loop
        Next
            
            
        Windows(Module1.Nom_Fichier).Activate
        Sheets("Feuil1").Select
        Range("B2").Select
        ReDim tablo(1 To 1)
        tablo(1) = Cells(2, 2)
        For Each c In Sheets("Feuil1").Range("B2:B" & Range("b65536").End(xlUp).Row)
            present = False
            For i = 1 To UBound(tablo)
                If tablo(i) c Then present True
            Next i
            If Not present Then
                ReDim Preserve tablo(1 To UBound(tablo) + 1)
                tablo(UBound(tablo)) = c
            End If
        Next c
        
        CA_Liste.List = tablo
        Application.DisplayAlerts = False
        Workbooks(Module1.Nom_Extract).Close (False)
        Application.DisplayAlerts = True
        
        Windows(Module1.Nom_Fichier).Activate
        Sheets("Feuil1").Select
        Range("E1").Select
        For i = 1 To UBound(tablo)
            ActiveCell.Value = tablo(i)
            ActiveCell.Offset(1, 0).Select
        Next
        
        Range("E1").Select
        Do Until ActiveCell.Value = ""
            r = ActiveCell.Row
            Valeur = ActiveCell.Value
            Range("B2").Select
            Somme = 0
            Do Until ActiveCell.Value = ""
            If ActiveCell.Value Valeur Then Somme Somme + ActiveCell.Offset(0, 1).Value
            ActiveCell.Offset(1, 0).Select
            Loop
        Cells(r, 5).Select
        ActiveCell.Offset(0, 1).Value = Somme
        ActiveCell.Offset(1, 0).Select
        Loop
        
        Columns("A:D").Delete
        Columns("A:B").Select
        Selection.Sort Key1:=Range("B1"), Order1:=xlDescending, Header:=xlGuess, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
        
        
        Range("A1").Value = "Code OS"
        Range("B1").Value = "Heure(s) dépensée(s) sur l'OS"
        Range("C1").Value = "Répartition Pointage"
        
        
        UserForm1.MousePointer = fmMousePointerDefault
        
        Range("A2").Select
        For i = 1 To Nb_OS_Limite
        H_Total = H_Total + ActiveCell.Offset(0, 1).Value
        ActiveCell.Offset(1, 0).Select
        Next
        Do Until ActiveCell.Value = ""
        Rows(ActiveCell.Row).Delete
        Loop
        
        Rapport = Nb_Heure.Value / H_Total
        
        Somme = 0
        Range("A2").Select
        Do Until ActiveCell.Value = ""
            ActiveCell.Offset(0, 2).Value = Round(ActiveCell.Offset(0, 1).Value * Rapport, 1)
            If ActiveCell.Offset(0, 2).Value = 0 Then
                Rows(ActiveCell.Row).Delete
            Else
                Somme = Somme + ActiveCell.Offset(0, 2).Value
                ActiveCell.Offset(1, 0).Select
            End If
        Loop
        ActiveCell.Offset(0, 1).Value = "Total:"
        ActiveCell.Offset(0, 2).Value = Nb_Heure.Value
        
        Range("C2").Value = Range("C2").Value + (Nb_Heure - Somme)
    Columns("A:D").Select
    Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    Ajout_et_enregistrement_classeur
    Application.DisplayAlerts = False
    Workbooks(Module1.Nom_Fichier).Close (False)
    Application.DisplayAlerts = True

    End
    End If
End If
0

Discussions similaires

Comment fonctionne la fonction FormulaR1C1
cs_razmokets -
wape -

2 réponses
fonction modulo en VBA
krisprolss -
Benouille -

2 réponses
Dernière cellule non vide d'une colonne
cs_falafala -
Luigi13013 -

5 réponses
A quoi sert la fonction Set ?
ICIoBRa -
ICIoBRa -

3 réponses
Modulo pour chiffres à virgule
cs_ebro -
Gally -

8 réponses
Rejoignez-nous