Recherche VBA

Le 30/04/2019 à 03:25

Bonjour,

Je suis à la recherche d'un VBA pour mon fichier joint.

A partir de nombre, il faut les décomposer pour les mettre dans les bonnes colonnes

Merci de voir le fichier pour plus de détail, un peu compliqué à expliquer comme ça...

Cordialement

Galiax

4zz-calcul-versement.zip (46.27 Ko)
Le 30/04/2019 à 05:09

Bonjour galiax,

voici une version avec formules

5zz-calcul-versement-formules.zip (47.40 Ko)

pour le VBA il faut que je me reveille avant

@ ++

Re,

bon pour inserer juste les formules dans l'onglet CIC par exemple, essaie ce code

Sub InsererFormules()
Dim x As Worksheet
Dim i As Integer, j As Integer

Application.ScreenUpdating = False

' affecter à l'onglet "CIC" la variable "x" pour ne pas repeter le nom à chaque fois
Set x = ThisWorkbook.Sheets("CIC")

' insértion formules dans K14:K20
    For i = 2 To 8
    x.Cells(12 + i, 11).FormulaR1C1 = "='Calcul CIC'!R[" & 24 - i & "]C[" & -i & "]"
    Next i

' insértion formules dans B21, D21, F21 et H21:K21
    With x.Range("B21, D21, F21, H21:K21")
        .FormulaR1C1 = "=SUM(R[-7]C:R[-1]C)"
     End With

' insértion formules dans B14:G20
    For j = 14 To 20
        x.Cells(j, 2).FormulaR1C1 = "=IF(RC[9]>NORME!R[-11]C[1],ROUNDDOWN(RC[9]/NORME!R[-11]C[1],0)*NORME!R[-11]C[1],0)"
        x.Cells(j, 3).FormulaR1C1 = "=IF(RC[-1]="""","""",RC[-1]/NORME!R[-11]C[4])"
        x.Cells(j, 4).FormulaR1C1 = "=RC[7]-RC[-2]-RC[2]"
        x.Cells(j, 5).FormulaR1C1 = "=RC[-1]/RC[-4]"
        x.Cells(j, 5).NumberFormat = "General"
        x.Cells(j, 6).FormulaR1C1 = "=IF(RC[5]-RC[-4]>NORME!R[-11]C[-1],ROUNDDOWN((RC[5]-RC[-4])/NORME!R[-11]C[-1],0)*NORME!R[-11]C[-1],0)"
        x.Cells(j, 7).FormulaR1C1 = "=RC[-1]/RC[-6]"
        x.Cells(j, 7).NumberFormat = "General"
    Next j

Application.ScreenUpdating = True
End Sub

avec ce code là , il te crée un nouveau onglet All-In-One

Sub ToutEnMacro()
Dim x As Worksheet, y As Worksheet, z As Worksheet
Dim FillRange As Variant
Dim i As Integer, j As Integer, k As Integer

Application.ScreenUpdating = False

' affecter à l'onglet "NORME" la variable "y" pour ne pas repeter le nom à chaque fois
Set y = ThisWorkbook.Sheets("NORME")

' créer un nouveau onglet et lui affecter le non "CIC_New"
    With ThisWorkbook
        Set z = .Sheets.Add(After:=.Sheets(.Sheets.Count))
        z.Name = "CIC_New"
    End With
' affecter au nouveau onglet une variable "x" pour ne pas repeter le nom à chaque fois
Set x = ThisWorkbook.Sheets("CIC_New")

' merger les céllules des ligne 12 et 13
    For k = 1 To 11
    With Range(Cells(12, k), Cells(13, k))
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Next k

' insérer les les titres des lignes 12 et 13
    FillRange = VBA.Array("QUOTITE", "VERSEMENT BDF" & vbCrLf & "SAISIE" & vbCrLf & "ATTENTE QUALITE", "Nbre de Billet", "MONTANT" & vbCrLf & "ROMPUS VRAC", "Nbre de Billet", "MONTANT" & vbCrLf & "ROMPUS LIASSES", "Nbre de Billet", "MONTANT" & vbCrLf & "ROMPUS BDF", "MONTANT DES" & vbCrLf & "COMMANDES", "MONTANT" & vbCrLf & "RELIQUAT BDF", "TOTAUX")
    x.Range("A12:K12").Value = FillRange

' ajuster la taille des lignes 12 à 21
    Rows("12:21").RowHeight = 29.4

' ajuster la taille des colonnes
    Columns("B:B").ColumnWidth = 28.11
    Range("C:C,E:E,G:G").ColumnWidth = 8.11
    Range("D:D,F:F,H:J").ColumnWidth = 19.33
    Columns("K:K").ColumnWidth = 25.33

' ajuster le format de la céllule B12/B13
    With Cells(12, 2)
        .Characters(Start:=1, Length:=22).Font.Size = 12
        .Characters(Start:=24, Length:=15).Font.Size = 14
        .Characters(Start:=24, Length:=15).Font.Bold = True
        .Font.Name = "Comic Sans MS"
        .Interior.ThemeColor = xlThemeColorDark1
        .Interior.TintAndShade = -0.349986266670736
    End With

' ajuster le format des céllules C12/K13

    With Range("C12:K13").Font
        .Name = "Comic Sans MS"
        .Size = 12
        .Bold = True
    End With

' copier les mormes dans A14/A20
    y.Range("A3:A9").Copy x.Range("A14")

' formater la céllule A21
    With x.Range("A21")
        .FormulaR1C1 = "TOTAUX"
        .Font.Name = "Comic Sans MS"
        .Font.Bold = True
        .Font.Size = 12
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With

' couleur jaune dans les céllules I14/I20
    With Range("I14:I20").Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With

' formater la céllule B21
    With x.Range("B21")
        .FormulaR1C1 = "=SUM(R[-7]C:R[-1]C)"
        .NumberFormat = "_($* #,##0_);_($* (#,##0);_($* ""-""_);_(@_)"
        .Font.Name = "Comic Sans MS"
        .Font.Size = 20
        .Font.Bold = True
        .VerticalAlignment = xlCenter
    End With

' formater les céllulea D21, F21 et H21:K21
    With x.Range("D21, F21, H21:K21")
        .FormulaR1C1 = "=SUM(R[-7]C:R[-1]C)"
        .NumberFormat = "_($* #,##0_);_($* (#,##0);_($* ""-""_);_(@_)"
        .Font.Name = "Comic Sans MS"
        .Font.Size = 16
        .Font.Bold = True
        .VerticalAlignment = xlCenter
    End With

' formater les céllulea K14:K21
    With x.Range("K14:K21")
        .NumberFormat = "_($* #,##0_);_($* (#,##0);_($* ""-""_);_(@_)"
        .VerticalAlignment = xlCenter
        .Font.Name = "Comic Sans MS"
        .Font.Size = 20
        .Font.Bold = True
        .Font.Color = RGB(42, 66, 242)
        .Font.TintAndShade = 0
    End With

' insérer les formules dans les céllules K14:K20
    For i = 2 To 8
    x.Cells(12 + i, 11).FormulaR1C1 = "='Calcul CIC'!R[" & 24 - i & "]C[" & -i & "]"
    Next i

' insérer les formules dans les céllules B14:G20
    For j = 14 To 20
        x.Cells(j, 2).FormulaR1C1 = "=IF(RC[9]>NORME!R[-11]C[1],ROUNDDOWN(RC[9]/NORME!R[-11]C[1],0)*NORME!R[-11]C[1],0)"
        x.Cells(j, 3).FormulaR1C1 = "=IF(RC[-1]="""","""",RC[-1]/NORME!R[-11]C[4])"
        x.Cells(j, 4).FormulaR1C1 = "=RC[7]-RC[-2]-RC[2]"
        x.Cells(j, 5).FormulaR1C1 = "=RC[-1]/RC[-4]"
        x.Cells(j, 5).NumberFormat = "General"
        x.Cells(j, 6).FormulaR1C1 = "=IF(RC[5]-RC[-4]>NORME!R[-11]C[-1],ROUNDDOWN((RC[5]-RC[-4])/NORME!R[-11]C[-1],0)*NORME!R[-11]C[-1],0)"
        x.Cells(j, 7).FormulaR1C1 = "=RC[-1]/RC[-6]"
        x.Cells(j, 7).NumberFormat = "General"
    Next j

' mettre les bordures
x.Range("A12:K21").Borders.LineStyle = xlContinuous

' zoomer la fenêtre
ActiveWindow.Zoom = 85

Application.ScreenUpdating = True
End Sub
Le 01/05/2019 à 00:04

Salut m3ellem1,

C'est exactement ce que je recherché

Merci bcp pour ton aide

Cordialement

Galiax

@++

Rechercher des sujets similaires à "recherche vba"