Autres Entrer un nombre

francescofrancesco

XLDnaute Junior
Bonjour,
Je dois entrer les nombres non séquentiels manquants dans la colonne C.
Comme vous pouvez le voir dans le fichier joint, il manque 7-8-9
les dates de référence dans la colonne B sont du 08/01/2021 au 15/01/2021.
Le 15-16-17 les dates de référence sont du 16/01/2021 au 27/01/2021.
Merci.
 

Pièces jointes

  • entrer.xls
    326 KB · Affichages: 23

fanch55

XLDnaute Barbatruc
Nouveau module Userform:
VB:
#If VBA7 Then
    Private Declare PtrSafe Function GetDC Lib "user32.dll" (ByVal hWnd As LongPtr) As LongPtr
    Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDC As LongPtr, ByVal nIndex As Long) As LongPtr
#Else
    Private Declare Function GetDC Lib "user32.dll" (ByVal hwnd as long) as long
    Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC as long, ByVal nIndex as long) as long
#End If
Option Explicit
Dim Target      As Range
Dim DerLigne    As Long
Private Sub CommandButton1_Click()
    Insert_Rows
End Sub
Sub Insert_Rows()
Dim N As Integer

    Application.ScreenUpdating = False
    
    Target.AutoFilter Field:=2, Criteria1:=TextBox1
    Target.AutoFilter Field:=3, Criteria1:=TextBox2
    
    If Target.SpecialCells(xlCellTypeVisible).Cells.Count > 3 Then
        ' 3 cellules d'entetes ==> pas de lignes filtrées
        Me.Caption = TextBox1 & " - " & TextBox2 & " déja existant"
        Beep
    Else
        Target.AutoFilter
        Rows(2).Insert xlDown, xlFormatFromRightOrBelow
        Cells(2, "B") = CDate(TextBox1)
        Cells(2, "C") = TextBox2
        DerLigne = DerLigne + 1
        Me.Caption = TextBox1 & " - " & TextBox2 & " Inséré"
              
        ' on trie par date et par n° de facture
        Set Target = Range("A1:C" & DerLigne)
        With ActiveSheet.Sort
            .SortFields.Clear
            .SortFields.Add Key:=Target.Columns("B"), _
                SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .SortFields.Add Key:=Target.Columns("C"), _
                SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
            .SetRange Target
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        
        ' on renumérote la colonne A
        With Columns("A").Rows("2:" & DerLigne)
            .NumberFormat = "General"
            .FormulaR1C1 = "=ROW()-1"
            .Value = .Value
        End With
        
        Target.AutoFilter Field:=2, Criteria1:=TextBox1
        Target.AutoFilter Field:=3, Criteria1:=TextBox2
        
    End If
    N = Target.SpecialCells(xlCellTypeVisible).Find(TextBox2).Row
    Target.AutoFilter Field:=3
    Target.Rows(N).Select
    TextBox2 = vbNullString

    Application.ScreenUpdating = True
    
End Sub

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    If TextBox1 <> "" Then
        TextBox1 = Format(TextBox1, "dd/mm/yyyy")
        Target.AutoFilter Field:=2, Criteria1:=TextBox1
        Target.AutoFilter Field:=3
    End If
    CommandButton1.Visible = TextBox1 <> ""
End Sub

Private Sub UserForm_Initialize()
    Caption = vbNullString
    CommandButton1.Visible = TextBox1 <> ""
    Worksheets("primanota").Activate
    DerLigne = Range("A" & Rows.Count).End(xlUp).Row
    Set Target = Range("A1:C" & DerLigne)
    If Not ActiveSheet.AutoFilter Is Nothing Then Target.AutoFilter

   ' Move_Usf ActiveSheet.Shapes(Application.Caller).TopLeftCell.Offset(1)
    Move_Usf ActiveSheet.[D2]
    
End Sub
Private Sub Move_Usf(Cellule As Range)
Dim X As Double, Y As Double
    
    ActiveWindow.Zoom = 100
    X = GetDeviceCaps(GetDC(0), 88) / 72    'Logical pixels/point in X
    Y = GetDeviceCaps(GetDC(0), 90) / 72    'Logical pixels/point in Y
    StartUpPosition = 0
    Left = ActiveWindow.PointsToScreenPixelsX(Cellule.Left * X) * 1 / X
    Top = ActiveWindow.PointsToScreenPixelsY(Cellule.Top * Y) * 1 / Y

End Sub

Private Sub UserForm_Terminate()
    If Not ActiveSheet.AutoFilter Is Nothing Then Target.AutoFilter
End Sub
 

Statistiques des forums

Discussions
311 733
Messages
2 082 019
Membres
101 872
dernier inscrit
Colin T