Format nombre (variable tableau +evenement feuille))

[cathodique]

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.

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

En vous remerciant par avance.

Cordialement,

 

[PMO2]

Re : Format nombre (variable tableau +evenement feuille))

Bonjour,

Peut être avec le code suivant dans lequel les modifications sont entre les '///

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 Trim(Tb(i, 4)) <> "" Then
              RES(4, j) = Round(Tb(i, 4), 2)  'PK
              
'              RES(5, j) = Application.WorksheetFunction.RoundUp(RES(4, j), 0) * -1    'arrondi supérieur
              RES(5, j) = Application.WorksheetFunction.RoundDown(RES(4, j), 0) * -1  'ou inférieur

'              RES(6, j) = Application.WorksheetFunction.RoundUp(RES(4, j), 0)         'arrondi supérieur
              RES(6, j) = Application.WorksheetFunction.RoundDown(RES(4, j), 0)       'ou inférieur
              
            Else
              RES(4, j) = ""
            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

 

[cathodique]

Re : Format nombre (variable tableau +evenement feuille))

Bonjour PMO2,

Je te remercie pour ton aide, le code que j'ai édité concerne l'extraction des données à partir de la feuille A.
Mon premier souci est l'affichage des valeurs extraites en colonne D de la feuille B au format "0.00".
Le code que tu me proposes résout en partie le problème. en effet, si le nombre est un décimal (ex: 112,634 en feuille A, il s'affiche 112,63 en feuille B) le format est bon.
Par contre si c'est un nombre entier le format ne s'applique pas
(ex: 0 reste 0 ou 150 reste 150, je voudrai 0-->0,00 ou 150-->150,00).

Pour les colonnes E et F, j'avais oublié de vous signaler qu'il s'agissait de gérer la saisie dans ces 2 colonnes et qui est traitée dans le code la feuille B ci-dessous:

Private Sub Worksheet_Change(ByVal Target As Range)
'trouver solution pour colonne F, ne doit accepter que des entiers
If Not Application.Intersect(Target, Range("F8:F30")) Is Nothing Then
Application.EnableEvents = False
     On Error Resume Next

'suite code
End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'gestion valeurs négatives colonne E
    If Not Intersect(Target, Range("E8:E30")) Is Nothing Then
     Application.EnableEvents = False
     On Error Resume Next
Application.EnableEvents = False

If IsNumeric(Target) = True Then
Target.Value = Target.Value * -1
End If

If Target.Value <= -5000 Then
MsgBox "Excessif par rapport aux valeurs usuelles!" & Chr(10) & _
"Erreur de saisie, Vérifier!", vbCritical
Target.ClearContents
Target.Select
End If

If Target.Value > 0 Then
Target.Interior.ColorIndex = 3
Target.Font.Bold = True
Else
Target.Interior.Pattern = xlNone
Target.Font.Bold = False
End If

If Target.Value = 0 Then
Target.ClearContents
End If

If Not IsNumeric(Target) = True Then
MsgBox "Valeur numérique obligatoire!", vbCritical
Target.ClearContents
Target.Select
End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Application.EnableEvents = True
      
End If

End Sub

Donc ce que je voulais faire pour la colonne E (le code semble donner un bon résultat):
1. je saisis un nombre, dans la cellule le signe "-" est insérer (ex: je saisis 12,89 , dans cellule ça devient -12,89)
[ici je voudrai que seuls le nombres entiers soient acceptés]. virgule et point non acceptée ou imposer que nombre entier, comment faire?
2. si le résultat dans la cellule (je saisis par ex: -1200, val=val*-1) est positif, alors police en gras et fond cellule en rouge.
3. si je saisis des caractères, alors message d'avertissement, effacement et resélectionne de la cellule

Pour la colonne F: je voudrai ne pouvoir saisir que des nombres entiers positifs

En espérant que c'est un peu plus clair.

Merci beaucoup pour votre aide.

Cordialement,

 

[kjin]

Re : Format nombre (variable tableau +evenement feuille))

Bonjour,
J'ai un peu remanié le code en incluant des validations pour les colonnes E et F
Dans un module

Sub SaisieNouveau()
Dim i&, j&, derlignA&, dercolB%, choix$
Dim wsB As Worksheet, wsA As Worksheet, c As Range
Dim tabloA, tabloB()

Application.ScreenUpdating = False
Set wsA = Sheets("A")
Set wsB = Sheets("B")

With wsA 'Worksheets("A")
    derlignA = .Cells(.Rows.Count, 1).End(xlUp).Row
    tabloA = .Range("A2:H" & derlignA)
End With

With wsB 'Worksheets("B")
    choix = .[B1]
    dercolB = .Range("A7").End(xlToRight).Column
    .Range(.Cells(8, 1), .Cells(.Rows.Count, dercolB)).Clear
    For i = 1 To UBound(tabloA, 1)
        If tabloA(i, 1) = choix Then
            j = j + 1
            ReDim Preserve tabloB(1 To dercolB, 1 To j)
            tabloB(1, j) = j
            tabloB(2, j) = tabloA(i, 2)
            tabloB(3, j) = tabloA(i, 3)
            On Error Resume Next
            tabloB(4, j) = Round(tabloA(i, 4), 2)
            On Error GoTo 0
            tabloB(7, j) = tabloA(i, 5)
        End If
    Next i
    If j > 0 Then
        Set c = .Range("A8").Resize(j, dercolB)
        With c
            .Value = Application.Transpose(tabloB)
            .Borders.Weight = xlThin
            .Font.Name = "calibri"
            .Font.Size = 12
            .VerticalAlignment = xlCenter
        End With
        c.Columns(5).Cells.Select
        With Selection.Validation
            .Delete
            .Add Type:=xlValidateWholeNumber, AlertStyle:=xlValidAlertStop, _
                    Operator:=xlBetween, Formula1:="-5000", Formula2:="0"
            .ErrorMessage = "La valeur doit être un entier compris entre 0 et -5000"
        End With
        c.Columns(6).Cells.Select
        With Selection.Validation
            .Delete
            .Add Type:=xlValidateWholeNumber, AlertStyle:=xlValidAlertStop, _
                    Operator:=xlGreater, Formula1:="0"
            .ErrorMessage = "La valeur doit être un entier sup à 0"
        End With
    End If
    .[B1].Activate
End With
End Sub

et dans le module de la feuille B

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$1" And Target.Count = 1 Then
        Application.EnableEvents = False
        SaisieNouveau
        Application.EnableEvents = True
End If
End Sub

kjin

 

[cathodique]

Re : Format nombre (variable tableau +evenement feuille))

Bonjour kjin,

Je te remercie beaucoup pour le fichier. Les codes fonctionnent bien sauf qu'ils ne répondent pas exactement à ce que je voulais obtenir.

Pour la colonne D (PK), les nombres entiers de la feuille A doivent être affichés avec les 2 Zéros en feuille B (ex: 47 --> 47,00)

Pour la colonne E, elle doit aussi accepter les nombres positifs, mais dans ce cas la cellule devient rouge et la valeur en gras. De plus avec ton code, je dois à chaque fois insérer le signe moins "-". ça va être la galère pour celui qui effectuera la saisie, car cette colonne ne comportera qu'exceptionnellement des valeurs positives.
mon code semble bien gérer cette partie , sauf pour les entiers. je pouvais aussi saisir des nombres décimaux, mais pas les caractères; l'insertion du signe "-" se fait par code.

Pour la colonne F, c'est bon avec la validation que des entiers positifs.

Je te remercie beaucoup.

Cordialement,

 

[kjin]

Re : Format nombre (variable tableau +evenement feuille))

Bonsoir,
PJ modifiée
kjin

 

[cathodique]

Re : Format nombre (variable tableau +evenement feuille)[ presque résolu]

Bonsoir Kjin,

Je te suis très reconnaissant, c'est exactement le résultat que je voulais obtenir. Sauf que, si par erreur on effectue une saisie (cellule colonne E) et qu'on efface (Suppr) dans la cellule apparait un "0", il est alors impossible d'avoir une cellule vide.

En réalité, sur mon fichier original, je passe par un userform pour insérer des données dans L'entête, dont entre-autre la date et le N°P qui permet la récupération des données pour constituer le tableau. Je pense pourvoir adapter ton code sur mon fichier original.

Je constate que ton code de la feuille B (Worksheet_Change) est beaucoup plus simple que le mien. J'avoue avoir passer environ une semaine, par à tâtons en effectuant essai après essai.

Mes connaissances sont assez limitées en VBA. Mes méthodes aussi ne sont pas très "orthodoxes", donc qu'elle la solution pour que la cellule se vide quand on utilise la touche "Suppr".

Encore merci, toute ma gratitude.

Cordialement,

 

[cathodique]

Re : Format nombre (variable tableau +evenement feuille))

Re,

je viens de parcourir ton module pour essayer de le comprendre. J n'ai pas bien compris le "on error resume next" le "goto 0".

Pourquoi sont-ils pour le premier juste avant la ligne de code qui gère les décimales, et juste après cette ligne pour le second

For i = 1 To UBound(tabloA, 1)
        If tabloA(i, 1) = choix Then
            j = j + 1
            ReDim Preserve tabloB(1 To dercolB, 1 To j)
            tabloB(1, j) = j
            tabloB(2, j) = tabloA(i, 2)
            tabloB(3, j) = tabloA(i, 3)
           '****ICI    *********
            On Error Resume Next
            tabloB(4, j) = Format(tabloA(i, 4), "0.00") * 1
            On Error GoTo 0
            '*************
            tabloB(7, j) = tabloA(i, 5)
        End If
    Next i

En te remerciant beaucoup, bonne soirée!

Cordialement,

 

[kjin]

Re : Format nombre (variable tableau +evenement feuille)[ presque résolu]

Bonsoir,

donc qu'elle la solution pour que la cellule se vide quand on utilise la touche "Suppr".

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$1" And Target.Count = 1 Then
        Application.EnableEvents = False
        SaisieNouveau
        Application.EnableEvents = True
End If
If Target.Row > 7 And Target.Column = 5 And Target.Count = 1 Then
    If Not IsEmpty(Target) Then
        Application.EnableEvents = False
        If IsNumeric(Target) Then
            Target = Round(Target * -1)
            If Target <= -5000 Then
                MsgBox "Excessif par rapport aux valeurs usuelles!" & Chr(10) & _
                                "Erreur de saisie, Vérifier!", vbCritical
                Target.ClearContents
            End If
        Else
            Application.Undo
        End If
        Application.EnableEvents = True
    End If
End If
End Sub

Re,
je viens de parcourir ton module pour essayer de le comprendre. J n'ai pas bien compris le "on error resume next" le "goto 0".

C'est un contrôle d'erreur dans le cas où la valeur n'est pas numérique.
Il n'a plus lieu d'être est doit être supprimé puisque le formatage des nombres se fait plus loin

Sub SaisieNouveau()
Dim i&, j&, derlignA&, dercolB%, choix$
Dim wsB As Worksheet, wsA As Worksheet, c As Range
Dim tabloA, tabloB()

Application.ScreenUpdating = False
Set wsA = Sheets("A")
Set wsB = Sheets("B")

With wsA 'Worksheets("A")
    derlignA = .Cells(.Rows.Count, 1).End(xlUp).Row
    tabloA = .Range("A2:H" & derlignA)
End With

With wsB 'Worksheets("B")
    choix = .[B1]
    dercolB = .Range("A7").End(xlToRight).Column
    .Range(.Cells(8, 1), .Cells(.Rows.Count, dercolB)).Clear
    For i = 1 To UBound(tabloA, 1)
        If tabloA(i, 1) = choix Then
            j = j + 1
            ReDim Preserve tabloB(1 To dercolB, 1 To j)
            tabloB(1, j) = j
            tabloB(2, j) = tabloA(i, 2)
            tabloB(3, j) = tabloA(i, 3)
            tabloB(4, j) = tabloA(i, 4)
            tabloB(7, j) = tabloA(i, 5)
        End If
    Next i
    If j > 0 Then
        Set c = .Range("A8").Resize(j, dercolB)
        With c
            .Value = Application.Transpose(tabloB)
            .Borders.Weight = xlThin
            .Font.Name = "calibri"
            .Font.Size = 12
            .VerticalAlignment = xlCenter
        End With
        c.Columns(4).Cells.NumberFormat = "0.00"
        c.Columns(5).Cells.Select
        With Selection
            .FormatConditions.Delete
            .FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, Formula1:="0"
            .FormatConditions(1).Font.Bold = True
            .FormatConditions(1).Interior.ColorIndex = 3
        End With
        c.Columns(6).Cells.Select
        With Selection.Validation
            .Delete
            .Add Type:=xlValidateWholeNumber, AlertStyle:=xlValidAlertStop, _
                    Operator:=xlGreater, Formula1:="0"
            .ErrorMessage = "La valeur doit être un entier sup à 0"
        End With
    End If
    .[B1].Activate
End With
End Sub

kjin

 

[cathodique]

[RESOLU] : Format nombre (variable tableau +evenement feuille)

Bonsoir Fjin,

Je te remercie beaucoup pour tes codes, tes corrections ainsi que tes explications. J'essayais de trouver une solution pour le fameux "0", j'ai rajouté un or Target=0

If Target <= -5000 Or Target = 0 Then

la cellule se vide quand j'efface la valeur, mais je n'étais pas vraiment convaincu. Enfin, pour dire la vérité si je n'avais pas eu de réponse, j'aurai gardé ce bout de code.

Encore merci, je peux dire que mon problème est résolu.

Bonne fin de soirée.

Cordialement,