Recherche VBA
g
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
m
Bonjour galiax,
voici une version avec formules
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
g
Salut m3ellem1,
C'est exactement ce que je recherché
Merci bcp pour ton aide
Cordialement
Galiax
@++