cathodique
XLDnaute Barbatruc
Bonjour,
Meilleurs vœux pour cette nouvelle année.
J'extrais des données en utilisant 2 tableaux d'une feuille A dans une autre B. Je voudrai donc que le format des nombres soit à 2 chiffres après la virgule pour la col D de la feuille B.
en tâtonnant, sur la feuille B, j'ai mis du code pour que la saisie ne soit que du numérique (col E) et convertir la saisie en nombre négatif, mais je ne suis pas parvenu à n'imposer que des entiers. je voudrai aussi imposer que des entiers positifs en col F.
En vous remerciant par avance.
Cordialement,
Meilleurs vœux pour cette nouvelle année.
J'extrais des données en utilisant 2 tableaux d'une feuille A dans une autre B. Je voudrai donc que le format des nombres soit à 2 chiffres après la virgule pour la col D de la feuille B.
en tâtonnant, sur la feuille B, j'ai mis du code pour que la saisie ne soit que du numérique (col E) et convertir la saisie en nombre négatif, mais je ne suis pas parvenu à n'imposer que des entiers. je voudrai aussi imposer que des entiers positifs en col F.
Code:
Sub SaisieNouveau()
Dim i As Long, j As Long, LastLig As Long
Dim o As Object, bd As Object
Dim Tb, RES()
Dim DerCol As Integer
Dim Val1 As String
'-------------------------------------------------------------------------
Application.EnableEvents = False
Application.ScreenUpdating = False
Set bd = Sheets("A") 'définit l'onglet bd
Dl = bd.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit derlg col1 onglet A
Set o = Sheets("B")
On Error Resume Next
'=======================================================================
With bd
LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
Tb = .Range("A2:H" & LastLig)
End With
With o 'Worksheets("A")
DerCol = o.Range("A7").End(xlToRight).Column
Val1 = .Range("B1") 'N°P
For i = 1 To LastLig - 1
If Tb(i, 1) = Val1 Then
j = j + 1
ReDim Preserve RES(1 To 12, 1 To j)
RES(1, j) = j
RES(2, j) = Tb(i, 2)
RES(3, j) = Tb(i, 3)
If RES(4, j) <> "" Then
RES(4, j) = Round(Tb(i, 4), 2) 'PK
Else
RES(4, j) = Tb(i, 4)
End If
RES(7, j) = Tb(i, 5) 'DIR
End If
Next i
LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
If LastLig > 8 Then .Range("A8:H" & LastLig).Clear
If j > 0 Then .Range("A8").Resize(j, 12) = Application.Transpose(RES)
.Range("A8").Resize(j, DerCol).Borders.Weight = xlThin
.Range("A8").Resize(j, DerCol).Font.Name = "calibri"
.Range("A8").Resize(j, DerCol).Font.Size = 12
.Range("A8").Resize(j, DerCol).HorizontalAlignment = xlCenter
.Range("A8").Resize(j, DerCol).VerticalAlignment = xlCenter
.Range("H8:H" & LastLig).Resize(j, DerCol).HorizontalAlignment = xlLeft
End With
Range("E8").Select
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Cordialement,
Pièces jointes
Dernière édition: