1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129
| Sub Test()
Dim DateDeb As Date, DateFin As Date
Dim Cellule As Range, Plage As Range
Dim Rechercheplage As String
Set Plage = Application.InputBox("saisir i2:i3000", "Choix de la plage", Type:=8)
Rechercheplage = InputBox("respecter le format majuscule-espace-date exemple AU 05", "Entrer la date d'echeance à rechercher")
If Rechercheplage = vbNullString Then Exit Sub
For Each Cellule In Plage
If InStr(1, Cellule.Value, Rechercheplage) > 0 Then
Range(Cellule.Address).Select
DateDeb = ActiveCell.Offset(0, -4)
DateFin = ActiveCell.Offset(0, -3)
If (DateDeb <= Date And DateFin >= Date) Then
ActiveCell.Offset(0, -7).Copy Sheets("prel").Cells(65535, 1).End(xlUp)(2)
ActiveCell.Offset(0, -5).Copy Sheets("prel").Cells(65535, 2).End(xlUp)(2)
ActiveCell.Offset(0, -8).Copy Sheets("prel").Cells(65535, 3).End(xlUp)(2)
End If
End If
Next
supprimeDoublons
rib
End Sub
Private Sub supprimeDoublons()
Sheets("prel").Activate
MaCellule = ("C2")
Range(MaCellule).Select
donnee1 = ActiveCell
ActiveCell.Offset(1, 0).Select
While ActiveCell <> ""
If ActiveCell = donnee1 Then
ActiveCell.Offset(-1, -1) = (ActiveCell.Offset(-1, -1) + ActiveCell.Offset(0, -1))
ActiveCell.EntireRow.Delete
ActiveCell.Offset(-1, 0).Select
donnee1 = ActiveCell
ActiveCell.Offset(1, 0).Select
Else
donnee1 = ActiveCell
ActiveCell.Offset(1, 0).Select
End If
Wend
End Sub
Private Sub rib()
Dim i As Integer, k As Integer
Sheets("prel").Activate
Range("a2").Select
Range(Selection, Selection.End(xlDown)).Select
i = Selection.Rows.Count
Range("d2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-3],rib1!R1C1:R300C4,4,0)"
Selection.AutoFill Destination:=ActiveCell.Range("A1:A" & i)
Range("E2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-4],rib1!R1C1:R300C5,5,0)"
Selection.AutoFill Destination:=ActiveCell.Range("A1:A" & i)
Range("F2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-5],rib1!R1C1:R300C6,6,0)"
Selection.AutoFill Destination:=ActiveCell.Range("A1:A" & i)
Range("G2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-6],rib1!R1C1:R300C7,7,0)"
Selection.AutoFill Destination:=ActiveCell.Range("A1:A" & i)
Range("H2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-7],rib1!R1C1:R300C8,8,0)"
Selection.AutoFill Destination:=ActiveCell.Range("A1:A" & i)
'Range("I2").Select
'ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-8],'FICHIER GAL'!R1C2:R3000C7,6,0) & ""-"" & VLOOKUP(RC[-8],'FICHIER GAL'!R1C2:R3000C4,3,0)"
'Selection.AutoFill Destination:=ActiveCell.Range("A1:A" & i)
'OU For k = ActiveCell To i
Columns("B:B").ColumnWidth = 12
Columns("C:C").ColumnWidth = 30
Columns("D:D").ColumnWidth = 36.57
Columns("E:E").Select
With Selection
.ColumnWidth = 9.57
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("F:F").Select
With Selection
.ColumnWidth = 10.57
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("G:G").Select
With Selection
.ColumnWidth = 12.29
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("H:H").Select
With Selection
.ColumnWidth = 5.86
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Calculate
End Sub |
Partager