Sub Traitement()
Dim td As Worksheet
Dim myDate As Date
Dim derligne As Long
Dim x As Range 'cellule affichant le coefficient multiplicateur 100
Dim taille As Range '1ère ligne contenant le symbole % dans les en-tête
Dim colonne As Integer 'n° de la colonne à modifier
Dim lignefin As Integer 'n° de la dernière ligne
On Error Resume Next 'si la feuille n'existe pas !
Application.DisplayAlerts = False: Sheets("traitement date").Delete: Application.DisplayAlerts = True
On Error GoTo 0 'plus de gestionnaire d'erreurs
Worksheets("PO - PB").Copy After:=Worksheets("base donnee") 'création de la feuille
ActiveSheet.Name = "traitement date" 'nom de la feuille'
Sheets("base donnee").Range("A1:DX1").Copy Sheets("traitement date").Range("A1:DX1")
ActiveSheet.AutoFilterMode = False 'desactiver les filtres'
ActiveWindow.FreezePanes = False 'désactiver les volets'
ligne = Range("A" & Rows.Count).End(xlUp).Row
colomne = Cells(1, Cells.Columns.Count).End(xlToLeft).Column
With Sheets("traitement date")
Set x = Range("A" & ligne + 10)
x.Value = 100
Set taille = .Range("A2:DX100")
For Each cell In taille
'detecter date et la mettre en texte + bon format
If IsDate(cell) Then
cell.EntireColumn.Rows("2:761").Select
Selection.NumberFormat = "@"
Selection.NumberFormat = "yyyy-mm-dd"
ElseIf InStr(1, cell.Text, "€") > 0 Then
cell.EntireColumn.Rows("2:761").Select
Selection.NumberFormat = "0.00" 'pour 2 décimales
ElseIf InStr(1, cell.Text, "%") > 0 Then
colonne = cell.Column
lignefin = cell.End(xlDown).Row
x.Copy
Range(Cells(1, colonne), Cells(lignefin, colonne)).PasteSpecial _
Paste:=xlPasteValues, Operation:=xlMultiply, SkipBlanks:=True
For i = 2 To lignefin
If CStr(Cells(i, colonne)) = "Erreur 2015" Then Cells(i, colonne) = ""
Next i
Selection.NumberFormat = "0.00"
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
End If
Next
End With
ActiveSheet.UsedRange.Replace What:="/", Replacement:="", LookAt:=xlWhole
End Sub
Sub Traitement()
'Désactive le recalcul automatique
Application.Calculation = xlCalculationManual
Dim td As Worksheet
Dim myDate As Date
Dim derligne As Long
Dim x As Range 'cellule affichant le coefficient multiplicateur 100
Dim taille As Range '1ère ligne contenant le symbole % dans les en-tête
Dim colonne As Integer 'n° de la colonne à modifier
Dim lignefin As Integer 'n° de la dernière ligne
On Error Resume Next 'si la feuille n'existe pas !
Application.DisplayAlerts = False: Sheets("traitement date").Delete: Application.DisplayAlerts = True
On Error GoTo 0 'plus de gestionnaire d'erreurs
Worksheets("PO - PB").Copy After:=Worksheets("base donnee") 'création de la feuille
ActiveSheet.Name = "traitement date" 'nom de la feuille'
Sheets("base donnee").Range("A1:DX1").Copy Sheets("traitement date").Range("A1:DX1")
ActiveSheet.AutoFilterMode = False 'desactiver les filtres'
ActiveWindow.FreezePanes = False 'désactiver les volets'
ligne = Range("A" & Rows.Count).End(xlUp).Row
colomne = Cells(1, Cells.Columns.Count).End(xlToLeft).Column
With Sheets("traitement date")
Set x = Range("A" & ligne + 10)
x.Value = 100
Set taille = .Range("A2:DX100")
For Each cell In taille
'detecter date et la mettre en texte + bon format
If IsDate(cell) Then
cell.EntireColumn.Rows("2:761").Select
Selection.NumberFormat = "@"
Selection.NumberFormat = "yyyy-mm-dd"
ElseIf InStr(1, cell.Text, "€") > 0 Then
cell.EntireColumn.Rows("2:761").Select
Selection.NumberFormat = "0.00" 'pour 2 décimales
ElseIf InStr(1, cell.Text, "%") > 0 Then
colonne = cell.Column
lignefin = cell.End(xlDown).Row
x.Copy
Range(Cells(1, colonne), Cells(lignefin, colonne)).PasteSpecial _
Paste:=xlPasteValues, Operation:=xlMultiply, SkipBlanks:=True
For i = 2 To lignefin
If CStr(Cells(i, colonne)) = "Erreur 2015" Then Cells(i, colonne) = ""
Next i
Selection.Style = "Comma"
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
End If
Next
End With
ActiveSheet.UsedRange.Replace What:="/", Replacement:="", LookAt:=xlWhole
'Active le recalcul automatique
Application.Calculation = xlCalculationAutomatic
End Sub
If cell.HasFormula = True Then
cell.EntireColumn.Rows("2:775").Select
selection.Copy
selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone