Erreur de type 13 sur formule simple

Le 18/08/2011 à 15:43

Bonjour à tous,

Je comprend pas trop pourquoi, mais j'ai une macro qui me fait des caprices, elle ronronnait jusqu'à présent et là bim, sur un simple test, j'ai une erreur d'exécution 13 : incompatibilité de type

je joins le fichier exemple (y a pas toute la base de données derrière donc la macro complète tournera pas, mais je vous sort la partie intéressante en premier!)

 If (((ActiveSheet.Cells(zz, 6) - ActiveSheet.Cells(zz - 1, 6)) + (ActiveSheet.Cells(zz, 7) - ActiveSheet.Cells(zz - 1, 7)) - ActiveSheet.Cells(zz - 1, 8)) >= 0) Then

Comme vous verrez dans le fichier, en colonne 6, c'est des dates et à côté des heures, j'ai tout mis dans le même format, j'ai toujours le même problème...

Bon je met la macro entière (c'est assez vilain et gros, je préfères prévenir...)

Sub TimeToFailure()

Application.ScreenUpdating = False
l = 2
m = 2

Sheets.Add After:=Sheets(Sheets.Count)
ActiveWorkbook.Sheets(Sheets.Count).Activate
Sheets(Sheets.Count).Name = "TTF"

For zz = 1 To 5
    ActiveWorkbook.ActiveSheet.Cells(1, zz) = ActiveWorkbook.Sheets("Feuille Codes").Cells(1, zz + 1)
    Next zz

ActiveWorkbook.ActiveSheet.Cells(1, 6) = "Date"
ActiveWorkbook.ActiveSheet.Cells(1, 7) = "Heure"
ActiveWorkbook.ActiveSheet.Cells(1, 8) = "Tps Arrêt"
ActiveWorkbook.ActiveSheet.Cells(1, 9) = "Etat"
ActiveWorkbook.ActiveSheet.Cells(1, 10) = "TTF"

For i = 327 To 388
Sheets("TTF").Activate
    If ActiveWorkbook.Sheets("Feuille Codes").Cells(i, 2) = 0 Then GoTo skipcalcul2:

    For zz = 1 To 5
    ActiveWorkbook.ActiveSheet.Cells(l, zz) = ActiveWorkbook.Sheets("Feuille Codes").Cells(i, zz + 1)
    Next zz
    m = l

    For k = 2 To 37224

        If (Sheets("Données").Cells(k, 12) <> Sheets("Feuille Codes").Cells(i, 6)) Then GoTo skipcalcul

        If ((Sheets("Données").Cells(k, 4) = "PREVENTIF") Or (Sheets("Données").Cells(k, 4) = "PREV-SUPERVISION")) Then GoTo skipcalcul

        If ((Sheets("Données").Cells(k, 4) = "CORR-SITE") Or (Sheets("Données").Cells(k, 4) = "CORR-INJUST") Or (Sheets("Données").Cells(k, 4) = "CORR-ASSIST") Or (Sheets("Données").Cells(k, 4) = "CORR-SUPERVISION")) Then

        Range(ActiveWorkbook.Sheets("Données").Cells(k, 6), ActiveWorkbook.Sheets("Données").Cells(k, 7)).Copy
        ActiveWorkbook.ActiveSheet.Cells(l, 6).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
        ActiveWorkbook.Sheets("Données").Cells(k, 25).Copy
        ActiveWorkbook.ActiveSheet.Cells(l, 8).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
        ActiveWorkbook.ActiveSheet.Cells(l, 9) = ActiveWorkbook.Sheets("Données").Cells(k, 20)
        l = l + 1
        End If

skipcalcul:
Next k

    ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range(ActiveSheet.Cells(m, 6), ActiveSheet.Cells(l - 1, 6)) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range(ActiveSheet.Cells(m, 7), ActiveSheet.Cells(l - 1, 7)) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.ActiveSheet.Sort
        .SetRange Range(ActiveSheet.Cells(m, 6), ActiveSheet.Cells(l - 1, 9))
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

For zz = m + 1 To l - 1

    ActiveSheet.Cells(zz, 10).NumberFormat = "[h]:mm:ss"
    If (((ActiveSheet.Cells(zz, 6) - ActiveSheet.Cells(zz - 1, 6)) + (ActiveSheet.Cells(zz, 7) - ActiveSheet.Cells(zz - 1, 7)) - ActiveSheet.Cells(zz - 1, 8)) >= 0) Then
    ActiveSheet.Cells(zz, 10) = ActiveSheet.Cells(zz, 6) - ActiveSheet.Cells(zz - 1, 6) + ActiveSheet.Cells(zz, 7) - ActiveSheet.Cells(zz - 1, 7) - ActiveSheet.Cells(zz - 1, 8)
    Else
    ActiveSheet.Cells(zz, 10) = ""
    End If
Next zz

    ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range(ActiveSheet.Cells(m + 1, 10), ActiveSheet.Cells(l - 1, 10)) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.ActiveSheet.Sort
        .SetRange Range(ActiveSheet.Cells(m + 1, 10), ActiveSheet.Cells(l - 1, 10))
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

Dim cmpt As Integer
Dim n As Long

cptremoy = 0

        ActiveSheet.Cells(m - 1, 12) = "Moyenne TTF"
recalcmoy:
ctestremoy = 0
        ActiveSheet.Cells(m, 12) = Application.WorksheetFunction.Average(Range(ActiveSheet.Cells(m + 1, 10), ActiveSheet.Cells(l - 1, 10)))
        ActiveSheet.Cells(m, 12).NumberFormat = "[h]:mm:ss"
        ActiveSheet.Cells(m + 1, 12) = "Ecart type TTF"
        ActiveSheet.Cells(m + 2, 12) = WorksheetFunction.StDev(Range(ActiveSheet.Cells(m + 1, 10), ActiveSheet.Cells(l - 1, 10)))
        ActiveSheet.Cells(m + 2, 12).NumberFormat = "[h]:mm:ss"

        If cptremoy > 2 Then GoTo skipfiltr:
        For ww = m + 1 To l - 1
            If ActiveSheet.Cells(ww, 10) >= ActiveSheet.Cells(m, 12) + 2 * ActiveSheet.Cells(m + 2, 12) Then
                ActiveSheet.Cells(ww, 11) = ActiveSheet.Cells(ww, 10)
                ActiveSheet.Cells(ww, 10) = ""
                ctestremoy = 1
            End If
        Next ww
        If ctestremoy = 1 Then
        cptremoy = cptremoy + 1
        End If

        If cptremoy > 0 Then GoTo recalcmoy:
skipfiltr:

        'Calcul du nombre de données pour normaliser le graph
        nbdonnees = 0
        For ww = m + 1 To l - 1

                    If ActiveSheet.Cells(ww, 10) <> "" Then
                    nbdonnees = nbdonnees + 1
                    End If
        Next ww
        n = Int(Sqr(nbdonnees))

        Range(Cells(m, 14), Cells(m + 3, 16)).NumberFormat = "[h]:mm:ss"

        ActiveSheet.Cells(m - 1, 13) = "Nombre de classes"
        ActiveSheet.Cells(m - 1, 14) = "Amplitude classes"
        ActiveSheet.Cells(m - 1, 15) = "Max"
        ActiveSheet.Cells(m - 1, 16) = "Min"

        For j = 0 To 3
        Sheets("TTF").Activate
        Range(ActiveSheet.Cells(m, 14), ActiveSheet.Cells(m + 3, 16 + n + j)).NumberFormat = "[h]:mm:ss"
        Range(ActiveSheet.Cells(m + 2 * j + 5, 17), ActiveSheet.Cells(m + 2 * j + 5, 16 + n + j)).NumberFormat = "[h]:mm:ss"
        ActiveSheet.Cells(m + j, 13) = n + j
        ActiveSheet.Cells(m + j, 14) = (Application.WorksheetFunction.Max(Range(ActiveSheet.Cells(m + 1, 10), ActiveSheet.Cells(l - 1, 10))) - Application.WorksheetFunction.Min(Range(ActiveSheet.Cells(m + 1, 10), ActiveSheet.Cells(l - 1, 10)))) / (n + j)
        ActiveSheet.Cells(m + j, 15) = Application.WorksheetFunction.Max(Range(ActiveSheet.Cells(m + 1, 10), ActiveSheet.Cells(l - 1, 10)))
        ActiveSheet.Cells(m + j, 16) = Application.WorksheetFunction.Min(Range(ActiveSheet.Cells(m + 1, 10), ActiveSheet.Cells(l - 1, 10)))

            For w = 1 To n + j

            ActiveSheet.Cells(m - 1, 16 + w) = "Max classe " & w
            ActiveSheet.Cells(m + j, 16 + w) = ActiveSheet.Cells(m + j, 16) + w * ActiveSheet.Cells(m + j, 14)
            ActiveSheet.Cells(m + 4, 16 + w) = "Centre classe " & w
            ActiveSheet.Cells(m + 2 * j + 5, 16 + w) = ActiveSheet.Cells(m + j, 16) + (2 * w - 1) / 2 * ActiveSheet.Cells(m + j, 14)
                cmpt = 0
                For ww = m + 1 To l - 1

                    If ((ActiveSheet.Cells(ww, 10) >= ActiveSheet.Cells(m + j, 15 + w)) And (ActiveSheet.Cells(ww, 10) <= ActiveSheet.Cells(m + j, 16 + w))) Then
                    cmpt = cmpt + 1
                    End If
                Next ww

            ActiveSheet.Cells(m + 2 * j + 6, 16 + w) = cmpt / (ActiveSheet.Cells(m + j, 14) * nbdonnees)
            Next w

            'Set gr = ActiveWorkbook.Charts.Add
                'With gr
                '.SetSourceData Source:=Range(Sheets("TTF").Cells(m + 2 * j + 5, 17), Sheets("TTF").Cells(m + 2 * j + 6, 16 + n + j)), PlotBy:=xlRows
               ' .ChartType = xlXYScatterSmooth
                '.Location Where:=xlLocationAsNewSheet

                '.HasTitle = True
                '.ChartTitle.Characters.Text = Sheets("Feuille Codes").Cells(i, 6) & " " & Sheets("TTF").Cells(m + j, 13)
                '.SeriesCollection(1).Name = Sheets("Feuille Codes").Cells(i, 6)
                '.Axes(xlCategory, xlPrimary).HasTitle = True
                '.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "TTF"
                '.Axes(xlValue, xlPrimary).HasTitle = True
                '.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Nb"
                '.PlotArea.Interior.ColorIndex = 2
                '.Axes(xlValue).MajorGridlines.Border.LineStyle = xlDot
                '.ChartArea.Font.Size = 14
                '.Deselect
                'End With

                'If ActiveWorkbook.Sheets("Feuille codes").Cells(i, 6) = ActiveWorkbook.Sheets("Feuille codes").Cells(i + 1, 6) Then
                'gr.Name = Sheets("Feuille Codes").Cells(i, 3) & " " & Sheets("Feuille Codes").Cells(i, 6) & " " & Sheets("TTF").Cells(m + j, 13)
                'Else
                'gr.Name = Sheets("Feuille Codes").Cells(i, 6) & " " & Sheets("TTF").Cells(m + j, 13)
                'End If

        'faire le ménage
        'Set gr = Nothing

        Sheets("TTF").Activate
        Next j

skipcalcul2:

Next i

Dim cmptm As Integer
        Dim nm As Long

        cptremoym = 0

        ActiveSheet.Cells(20, 12) = "Moyenne TTF MTIPF SI"
recalcmoym:
        ctestremoym = 0
        ActiveSheet.Cells(21, 12) = Application.WorksheetFunction.Average(Range(ActiveSheet.Cells(2, 10), ActiveSheet.Cells(l, 11)))
        ActiveSheet.Cells(21, 12).NumberFormat = "[h]:mm:ss"
        ActiveSheet.Cells(22, 12) = "Ecart type TTF MTIPF SI"
        ActiveSheet.Cells(23, 12) = WorksheetFunction.StDev(Range(ActiveSheet.Cells(2, 10), ActiveSheet.Cells(l, 11)))
        ActiveSheet.Cells(23, 12).NumberFormat = "[h]:mm:ss"

        If cptremoym > 1 Then GoTo skipfiltrm:
        For ww = 2 To l
            If ActiveSheet.Cells(ww, 10) >= ActiveSheet.Cells(21, 12) + 4 * ActiveSheet.Cells(23, 12) Then
                ActiveSheet.Cells(ww, 10) = ""
                ctestremoym = 1
            End If
            If ActiveSheet.Cells(ww, 11) >= ActiveSheet.Cells(21, 12) + 4 * ActiveSheet.Cells(23, 12) Then
                ActiveSheet.Cells(ww, 11) = ""
                ctestremoym = 1
            End If
        Next ww
        If ctestremoym = 1 Then
        cptremoym = cptremoym + 1
        End If

        If cptremoym > 0 Then GoTo recalcmoym:
skipfiltrm:

        'Calcul du nombre de données pour normaliser le graph
        nbdonnees = 0
        For ww = 2 To l - 1

                    If ActiveSheet.Cells(ww, 10) <> "" Then
                    nbdonnees = nbdonnees + 1
                    End If
                    If ActiveSheet.Cells(ww, 11) <> "" Then
                    nbdonnees = nbdonnees + 1
                    End If
        Next ww
        nm = Int(Sqr(nbdonnees))

        Range(Cells(20, 14), Cells(23, 16)).NumberFormat = "[h]:mm:ss"

        ActiveSheet.Cells(20, 13) = "Nombre de classes"
        ActiveSheet.Cells(20, 14) = "Amplitude classes"
        ActiveSheet.Cells(20, 15) = "Max"
        ActiveSheet.Cells(20, 16) = "Min"

        For j = 0 To 5
        Sheets("TTF").Activate
        Range(ActiveSheet.Cells(20, 14), ActiveSheet.Cells(26, 16 + nm + j)).NumberFormat = "[h]:mm:ss"
        Range(ActiveSheet.Cells(20 + 2 * j + 5, 17), ActiveSheet.Cells(20 + 2 * j + 5, 16 + nm + j)).NumberFormat = "[h]:mm:ss"
        ActiveSheet.Cells(21 + j, 13) = nm + j
        ActiveSheet.Cells(21 + j, 14) = (Application.WorksheetFunction.Max(Range(ActiveSheet.Cells(2, 10), ActiveSheet.Cells(l, 10))) - Application.WorksheetFunction.Min(Range(ActiveSheet.Cells(2, 10), ActiveSheet.Cells(l, 10)))) / (nm + j)
        ActiveSheet.Cells(21 + j, 15) = Application.WorksheetFunction.Max(Range(ActiveSheet.Cells(2, 10), ActiveSheet.Cells(l, 10)))
        ActiveSheet.Cells(21 + j, 16) = Application.WorksheetFunction.Min(Range(ActiveSheet.Cells(2, 10), ActiveSheet.Cells(l, 10)))
        Range(ActiveSheet.Cells(28 + 2 * j, 17), ActiveSheet.Cells(28 + 2 * j, 16 + nm + j)).NumberFormat = "[h]:mm:ss"

            For w = 1 To nm + j

            ActiveSheet.Cells(20, 16 + w) = "Max classe " & w
            ActiveSheet.Cells(21 + j, 16 + w) = ActiveSheet.Cells(21 + j, 16) + w * ActiveSheet.Cells(21 + j, 14)
            ActiveSheet.Cells(27, 16 + w) = "Centre classe " & w
            ActiveSheet.Cells(28 + 2 * j, 16 + w) = ActiveSheet.Cells(21 + j, 16) + (2 * w - 1) / 2 * ActiveSheet.Cells(21 + j, 14)

                cmptm = 0
                For ww = 2 To l

                    If ((ActiveSheet.Cells(ww, 10) >= ActiveSheet.Cells(21 + j, 15 + w)) And (ActiveSheet.Cells(ww, 10) <= ActiveSheet.Cells(21 + j, 16 + w))) Then
                    cmptm = cmptm + 1
                    End If
                    If ((ActiveSheet.Cells(ww, 11) >= ActiveSheet.Cells(21 + j, 15 + w)) And (ActiveSheet.Cells(ww, 10) <= ActiveSheet.Cells(21 + j, 16 + w))) Then
                    cmptm = cmptm + 1
                    End If
                Next ww

            ActiveSheet.Cells(29 + 2 * j, 16 + w) = cmptm / (ActiveSheet.Cells(21 + j, 14) * nbdonnees)
            Next w

            Set gr = ActiveWorkbook.Charts.Add
                With gr
                .SetSourceData Source:=Range(Sheets("TTF").Cells(28 + 2 * j, 17), Sheets("TTF").Cells(29 + 2 * j, 16 + nm + j)), PlotBy:=xlRows
                .ChartType = xlXYScatterSmooth
                .Location Where:=xlLocationAsNewSheet

                .HasTitle = True
                .ChartTitle.Characters.Text = Sheets("Feuille Codes").Cells(i, 6) & " " & Sheets("TTF").Cells(21 + j, 13)
                .SeriesCollection(1).Name = Sheets("Feuille Codes").Cells(i, 6)
                .Name = Sheets("Feuille Codes").Cells(i, 6) & " " & Sheets("TTF").Cells(21 + j, 13)
                .Axes(xlCategory, xlPrimary).HasTitle = True
                .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "TTF"
                .Axes(xlValue, xlPrimary).HasTitle = True
                .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Nb"
                .PlotArea.Interior.ColorIndex = 2
                .Axes(xlValue).MajorGridlines.Border.LineStyle = xlDot
                .ChartArea.Font.Size = 14
                .Deselect
                End With

'faire le ménage
Set gr = Nothing

      Sheets("TTF").Activate
        Next j

Application.ScreenUpdating = True

End Sub

Sub classMoyTtfMtipfSi()

Application.ScreenUpdating = False

Dim cmptm As Integer
        Dim nm As Long

        cptremoym = 0

        ActiveSheet.Cells(20, 12) = "Moyenne TTF MTIPF SI"
recalcmoym:
        ctestremoym = 0
        ActiveSheet.Cells(21, 12) = Application.WorksheetFunction.Average(Range(ActiveSheet.Cells(2, 10), ActiveSheet.Cells(23095, 11)))
        ActiveSheet.Cells(21, 12).NumberFormat = "[h]:mm:ss"
        ActiveSheet.Cells(22, 12) = "Ecart type TTF MTIPF SI"
        ActiveSheet.Cells(23, 12) = WorksheetFunction.StDev(Range(ActiveSheet.Cells(2, 10), ActiveSheet.Cells(23095, 11)))
        ActiveSheet.Cells(23, 12).NumberFormat = "[h]:mm:ss"

        If cptremoym > 1 Then GoTo skipfiltrm:
        For ww = 2 To 23095
            If ActiveSheet.Cells(ww, 10) >= ActiveSheet.Cells(21, 12) + 4 * ActiveSheet.Cells(23, 12) Then
                ActiveSheet.Cells(ww, 10) = ""
                ctestremoym = 1
            End If
            If ActiveSheet.Cells(ww, 11) >= ActiveSheet.Cells(21, 12) + 4 * ActiveSheet.Cells(23, 12) Then
                ActiveSheet.Cells(ww, 11) = ""
                ctestremoym = 1
            End If
        Next ww
        If ctestremoym = 1 Then
        cptremoym = cptremoym + 1
        End If

        If cptremoym > 0 Then GoTo recalcmoym:
skipfiltrm:

        'Calcul du nombre de données pour normaliser le graph
        nbdonnees = 0
        For ww = 2 To 23095

                    If ActiveSheet.Cells(ww, 10) <> "" Then
                    nbdonnees = nbdonnees + 1
                    End If
                    If ActiveSheet.Cells(ww, 11) <> "" Then
                    nbdonnees = nbdonnees + 1
                    End If
        Next ww
        nm = Int(Sqr(nbdonnees)) * 2

        Range(Cells(20, 14), Cells(23, 16)).NumberFormat = "[h]:mm:ss"

        ActiveSheet.Cells(20, 13) = "Nombre de classes"
        ActiveSheet.Cells(20, 14) = "Amplitude classes"
        ActiveSheet.Cells(20, 15) = "Max"
        ActiveSheet.Cells(20, 16) = "Min"

        For j = 0 To 5
        Sheets("TTF").Activate
        Range(ActiveSheet.Cells(20, 14), ActiveSheet.Cells(26, 16 + nm + j)).NumberFormat = "[h]:mm:ss"
        Range(ActiveSheet.Cells(20 + 2 * j + 5, 17), ActiveSheet.Cells(20 + 2 * j + 5, 16 + nm + j)).NumberFormat = "[h]:mm:ss"
        ActiveSheet.Cells(21 + j, 13) = nm + j
        ActiveSheet.Cells(21 + j, 14) = (Application.WorksheetFunction.Max(Range(ActiveSheet.Cells(2, 10), ActiveSheet.Cells(23095, 10))) - Application.WorksheetFunction.Min(Range(ActiveSheet.Cells(2, 10), ActiveSheet.Cells(23095, 10)))) / (nm + j)
        ActiveSheet.Cells(21 + j, 15) = Application.WorksheetFunction.Max(Range(ActiveSheet.Cells(2, 10), ActiveSheet.Cells(23095, 10)))
        ActiveSheet.Cells(21 + j, 16) = Application.WorksheetFunction.Min(Range(ActiveSheet.Cells(2, 10), ActiveSheet.Cells(23095, 10)))
        Range(ActiveSheet.Cells(28 + 2 * j, 17), ActiveSheet.Cells(28 + 2 * j, 16 + nm + j)).NumberFormat = "[h]:mm:ss"

            For w = 1 To nm + j + 9

            Select Case w
            Case 1 To 4
            ActiveSheet.Cells(20, 16 + w) = "Max classe " & w
            ActiveSheet.Cells(21 + j, 16 + w) = ActiveSheet.Cells(21 + j, 16) + w * ActiveSheet.Cells(21 + j, 14) / 4
            ActiveSheet.Cells(27, 16 + w) = "Centre classe " & w
            ActiveSheet.Cells(28 + 2 * j, 16 + w) = ActiveSheet.Cells(21 + j, 16) + (2 * w - 1) / 8 * ActiveSheet.Cells(21 + j, 14)
            Case 5 To 7
            ActiveSheet.Cells(20, 16 + w) = "Max classe " & w
            ActiveSheet.Cells(21 + j, 16 + w) = ActiveSheet.Cells(21 + j, 16) + w * ActiveSheet.Cells(21 + j, 14) / 3
            ActiveSheet.Cells(27, 16 + w) = "Centre classe " & w
            ActiveSheet.Cells(28 + 2 * j, 16 + w) = ActiveSheet.Cells(21 + j, 16) + (2 * w - 1) / 6 * ActiveSheet.Cells(21 + j, 14)
            Case 8 To 11
            ActiveSheet.Cells(20, 16 + w) = "Max classe " & w
            ActiveSheet.Cells(21 + j, 16 + w) = ActiveSheet.Cells(21 + j, 16) + w * ActiveSheet.Cells(21 + j, 14) / 2
            ActiveSheet.Cells(27, 16 + w) = "Centre classe " & w
            ActiveSheet.Cells(28 + 2 * j, 16 + w) = ActiveSheet.Cells(21 + j, 16) + (2 * w - 1) / 4 * ActiveSheet.Cells(21 + j, 14)
            Case Else
            ActiveSheet.Cells(20, 16 + w) = "Max classe " & w
            ActiveSheet.Cells(21 + j, 16 + w) = ActiveSheet.Cells(21 + j, 16) + w * ActiveSheet.Cells(21 + j, 14)
            ActiveSheet.Cells(27, 16 + w) = "Centre classe " & w
            ActiveSheet.Cells(28 + 2 * j, 16 + w) = ActiveSheet.Cells(21 + j, 16) + (2 * w - 1) / 2 * ActiveSheet.Cells(21 + j, 14)
            End Select

                cmptm = 0
                For ww = 2 To 23095

                    If ((ActiveSheet.Cells(ww, 10) <> "") And (ActiveSheet.Cells(ww, 10) >= ActiveSheet.Cells(21 + j, 15 + w)) And (ActiveSheet.Cells(ww, 10) <= ActiveSheet.Cells(21 + j, 16 + w))) Then
                    cmptm = cmptm + 1
                    End If
                    If ((ActiveSheet.Cells(ww, 10) <> "") And (ActiveSheet.Cells(ww, 11) >= ActiveSheet.Cells(21 + j, 15 + w)) And (ActiveSheet.Cells(ww, 10) <= ActiveSheet.Cells(21 + j, 16 + w))) Then
                    cmptm = cmptm + 1
                    End If
                Next ww

            Select Case w
            Case 1 To 8
            ActiveSheet.Cells(29 + 2 * j, 16 + w) = cmptm / (ActiveSheet.Cells(21 + j, 14) / 4 * nbdonnees)
            Case 9 To 14  
            ActiveSheet.Cells(29 + 2 * j, 16 + w) = cmptm / (ActiveSheet.Cells(21 + j, 14) / 3 * nbdonnees)
            Case 15 To 18
            ActiveSheet.Cells(29 + 2 * j, 16 + w) = cmptm / (ActiveSheet.Cells(21 + j, 14) / 2 * nbdonnees)
            Case Else
            ActiveSheet.Cells(29 + 2 * j, 16 + w) = cmptm / (ActiveSheet.Cells(21 + j, 14) * nbdonnees)
            End Select

            ActiveSheet.Cells(29 + 2 * j, 16 + w).NumberFormat = "0.000"

            Next w

            Set gr = ActiveWorkbook.Charts.Add
                With gr
                .SetSourceData Source:=Range(Sheets("TTF").Cells(28 + 2 * j, 17), Sheets("TTF").Cells(29 + 2 * j, 16 + nm + j)), PlotBy:=xlRows
                .ChartType = xlXYScatterSmooth
                .Location Where:=xlLocationAsNewSheet

                .HasTitle = True
                '.ChartTitle.Characters.Text = Sheets("Feuille Codes").Cells(i, 6) & " " & Sheets("TTF").Cells(21 + j, 13)
                '.SeriesCollection(1).Name = Sheets("Feuille Codes").Cells(i, 6)
                '.Name = Sheets("Feuille Codes").Cells(i, 6) & " " & Sheets("TTF").Cells(21 + j, 13)
                .Axes(xlCategory, xlPrimary).HasTitle = True
                .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "TTF"
                .Axes(xlValue, xlPrimary).HasTitle = True
                .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Nb"
                .PlotArea.Interior.ColorIndex = 2
                .Axes(xlValue).MajorGridlines.Border.LineStyle = xlDot
                .ChartArea.Font.Size = 14
                .SeriesCollection(1).Trendlines.Add
                .Deselect
                End With

    gr.SeriesCollection(1).Trendlines(1).Select
    With Selection
        .Type = xlPolynomial
        .Order = 6
        .DisplayRSquared = True
        .DisplayEquation = True
    End With
    gr.SeriesCollection(1).Trendlines(1).DataLabel.Select
    Selection.Left = 389.259
    Selection.Top = 53.051

'faire le ménage
Set gr = Nothing

      Sheets("TTF").Activate
        Next j

Application.ScreenUpdating = True

End Sub

Merci d'avance!

21pb-reuk.zip (9.68 Ko)
Le 18/08/2011 à 16:24

Bonjour

Contrairement aux apparences tes deux colonnes sont du texte et pas des dates ou heures

Sélectionnes tes deux colonnes et multiplies les par 1

Méthode

Ecris 1 dans une cellule

Copie de cette cellule

Sélection des deux colonnes F et G

Collage spécial --> Multiplication

Ensuite remets tes colonnes au bon format

Cela ira mieux après

Le 18/08/2011 à 16:35

Ahh ouais, effectivement!

J'avais pas ce problème avant parce que les données avait été extraites autrement mais il en manquait la moitié...

Merci beaucoup du coup d'oeil avisé!

Je clos!

-- 18 Août 2011, 16:50 --

Bah je sais pas pourquoi mais ce que j'ai rajouté comme copier coller ne transforme pas toutes lignes et pourtant ma sélection est bonne, une idée?

Ca fait dans les entre 200 et 800 lignes entre m et l

D'ailleurs, je crois qu'il y a que les dates qui sont pas toutes converties...

ActiveSheet.Cells(1, 500) = 1
    ActiveSheet.Cells(1, 500).Select
    Selection.Copy

    Range(ActiveSheet.Cells(m+1, 6), ActiveSheet.Cells(l - 1, 8)).Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply, _
        SkipBlanks:=False, Transpose:=False

    Selection.NumberFormat = "[h]:mm:ss"
    Range(ActiveSheet.Cells(m + 1, 6), ActiveSheet.Cells(l - 1, 6)).Select
    Selection.NumberFormat = "dd/mm/yyyy"
    Application.CutCopyMode = False
    ActiveSheet.Cells(1, 500).Clear

-- 18 Août 2011, 17:32 --

Bon maintenant, j'ai voulu passer par la fonction cnum à chaque récupération de données, mais quand j'utilise value dans worksheetfunction, ça marche pas... Ni value2...

Donc j'ai essayé avec CDbl, mais j'y arrive pas non plus...

ActiveWorkbook.ActiveSheet.Cells(l, 6) = Sheets("Données").Cells(k, 6)
        ActiveWorkbook.ActiveSheet.Cells(l, 6) = CDbl(ActiveWorkbook.ActiveSheet.Cells(l, 6))
        ActiveWorkbook.ActiveSheet.Cells(l, 7) = Application.WorksheetFunction.Value(ActiveWorkbook.Sheets("Données").Cells(k, 7))
        ActiveWorkbook.ActiveSheet.Cells(l, 8) = Application.WorksheetFunction.Value2(ActiveWorkbook.Sheets("Données").Cells(k, 25))
Le 18/08/2011 à 17:40

Bonjour

Pour récupérer une date lorsque celle-ci est en texte c'est DateValue et pour l'heure c'est TimeValue

Si c'est ce que tu voulais

Le 18/08/2011 à 17:56

Nickel, quelques corrections derrière mais ça m'a super bien débloquer!

Merci chef!

Cette fois, ça tourne parfaitement!

Rechercher des sujets similaires à "erreur type formule simple"