Remplacer "," par "." + qques pb VBA

Le 26/07/2011 à 12:24

Bonjour,

A l'aide de vba-new, j'ai une macro (voir ci-dessous) qui copy des données de la feuil4 dans la feuil1 avec pleins de contraintes et conditions.

Voici la macro

    Sub remplit()

            Dim plage As Range
            Dim lg As Integer
            Dim i As Integer
            Set plage = Sheets("Feuil2").Range("A3:A" & Sheets("Feuil2").Range("A" & Rows.Count).End(xlUp).Row)
            With Sheets("Feuil4")
            .Range("A1").RemoveSubtotal
            For i = 2 To .Range("I" & Rows.Count).End(xlUp).Row
            On Error Resume Next
            lg = WorksheetFunction.Match(.Range("I" & i), plage, 0) + 2
            If lg > 0 Then
                .Range("I" & i) = Sheets("Feuil2").Range("B" & lg)
            End If
            lg = 0
            Next
            End With

        With Application

            moisCompta = Application.InputBox("Entrez le mois et l'année de comptabilisation sous format aaaamm00 (Ex : 20110700)", "Mois comptabilisation")
            If VarType(moisCompta) = vbBoolean Then MsgBox "Pourquoi avoir cliqué sur annuler ?", vbExclamation: Exit Sub

            .Calculation = xlCalculationManual
            .ScreenUpdating = False

            ou = 7    '<--- ligne à laquelle commence l'automatisation, à changer s'il le faut
           ou2 = ou - 2    '<--- ne pas toucher celle-là

            If Range("A" & Rows.Count).End(xlUp).Row > 6 Then
                Range("A7:AH" & Range("A" & Rows.Count).End(xlUp).Row).ClearContents
            End If
            Range("A" & ou).FormulaR1C1 = _
            "=IF(OR(RC6=""ACHA"",RC6=""OP"",RC6=""RD"",RC6=""EXT"",RC6=""QA"",RC6=""CL"",RC6=""GA""),3,4)"
            Range("C" & ou).FormulaR1C1 = "=" & moisCompta
            Range("D" & ou).FormulaR1C1 = "ACH"
            Range("E" & ou).FormulaR1C1 = "=11040001"
            Range("F" & ou).FormulaR1C1 = _
            "=IF(OR(Feuil4!R[-" & ou2 & "]C9=""ACHA"",Feuil4!R[-" & ou2 & "]C9=""OP"",Feuil4!R[-" & ou2 & "]C9=""RD"",Feuil4!R[-" & ou2 & "]C9=""EXT"",Feuil4!R[-" & ou2 & "]C9=""QA"",Feuil4!R[-" & ou2 & "]C9=""CL"",Feuil4!R[-" & ou2 & "]C9=""GA""),Feuil4!R[-" & ou2 & "]C9,"""")"
            Range("G" & ou).FormulaR1C1 = "=IF(RC6="""",Feuil4!R[-" & ou2 & "]C9,"""")"
            Range("H" & ou).FormulaR1C1 = "=IF(RC1=3,625100,"""")"
            Range("I" & ou).FormulaR1C1 = "=IF(RC1=3,""DPL"","""")"
            Range("J" & ou).FormulaR1C1 = "=625100"
            Range("K" & ou).FormulaR1C1 = _
            "=IF(RC6="""",931000,VLOOKUP(RC6,Feuil3!R1C1:R8C2,2,0))"
            Range("L" & ou).FormulaR1C1 = "=RC7"
            Range("M" & ou).FormulaR1C1 = "=IF(RC1=4,1,"""")"
            Range("N" & ou).FormulaR1C1 = "=IF(RC1=4,14,"""")"
            Range("O" & ou).FormulaR1C1 = "=IF(RC1=4,14,"""")"
            Range("P" & ou).FormulaR1C1 = "EUR"
            Range("Q" & ou).FormulaR1C1 = "D"
            Range("R" & ou).FormulaR1C1 = "=Feuil4!R[-" & ou2 & "]C8"
            Range("S" & ou).FormulaR1C1 = "1.0000"
            Range("T" & ou).FormulaR1C1 = "=Feuil4!R[-" & ou2 & "]C8"
            Range("W" & ou).FormulaR1C1 = "0158"
            Range("AE" & ou).FormulaR1C1 = "=Feuil4!R[-" & ou2 & "]C1"
            Range("AF" & ou).FormulaR1C1 = "=IF(ISNUMBER(Feuil4!R[-1]C2),Feuil4!R[-1]C2,DATEVALUE(Feuil4!R[-1]C2))"
            Range("AG" & ou).FormulaR1C1 = "=Feuil4!R[-" & ou2 & "]C4" & "&"" vers ""&" & "Feuil4!R[-" & ou2 & "]C5"
            Range("AH" & ou).FormulaR1C1 = "=EOMONTH(RC32,0)"
            Range("AI" & ou).FormulaR1C1 = "=25100"
            nbLign = Sheets("Feuil4").Range("A" & Rows.Count).End(xlUp).Row - 1
            Set fillRange = Range("A" & ou & ":AI" & ou).Resize(nbLign)
            Range("A" & ou & ":AI" & ou).AutoFill Destination:=fillRange
            Range("S" & ou).AutoFill Destination:=Range("S" & ou).Resize(nbLign), Type:=xlFillCopy
            Range("W" & ou).AutoFill Destination:=Range("W" & ou).Resize(nbLign), Type:=xlFillCopy
            Range("A3,A4").FormulaR1C1 = "1"
            Range("B3,B4").FormulaR1C1 = "SF"
            Range("C3,C4").FormulaR1C1 = "=" & moisCompta
            Range("D3,D4").FormulaR1C1 = "ACH"
            Range("E3,E4").FormulaR1C1 = "11040001"
            Range("K3").FormulaR1C1 = "401000"
            Range("K4").FormulaR1C1 = "445667"
            Range("L3").FormulaR1C1 = "0158"
            Range("L4").FormulaR1C1 = "201104"
            Range("P3,P4").FormulaR1C1 = "EUR"
            Range("Q3").FormulaR1C1 = "C"
            Range("Q4").FormulaR1C1 = "D"
            Range("W3,W4").FormulaR1C1 = "0158"
            Range("X3,X4").FormulaR1C1 = "SOAAAAAJ"
            Range("Z3,Z4").FormulaR1C1 = "P"
            Range("AC4").FormulaR1C1 = "E"
            Range("AD4").FormulaR1C1 = "0"
            Range("S3,S4").FormulaR1C1 = "1.0000"
            .Calculation = xlCalculationAutomatic

           fillRange.Value = fillRange.Value
        End With

    End Sub

Il me reste quelques petits problème à résoudre.

J'aimerai pouvoir remplacer toutes les virgules par des points. Je pense donc utiliser ce bout de macro mais après test cela ne fonctionne pas.

    Selection.Replace What:=",", Replacement:=".", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

Deuxième problème,

J'aimerai qu'en cellule :

* R3 qu'il y ait inscrit la somme de la colonne H en feuil 4 (Montant Facturé TTC)

* R4, la somme de la colonne G de la feuil4 (montant TVA)

33test.zip (150.10 Ko)
Le 26/07/2011 à 15:26

Salut alexis,

AlexisSz a écrit :

J'aimerai qu'en cellule :

* R3 qu'il y ait inscrit la somme de la colonne H en feuil 4 (Montant Facturé TTC)

* R4, la somme de la colonne G de la feuil4 (montant TVA)

Tu peux essayer de faire cette partie avec l'enregistreur de macro. Si tu n'y arrives pas, reviens.
AlexisSz a écrit :

J'aimerai pouvoir remplacer toutes les virgules par des points. Je pense donc utiliser ce bout de macro mais après test cela ne fonctionne pas.

Tu veux faire le remplacement sur toute la feuil1 ?
Le 26/07/2011 à 15:31

J'aimerai pouvoir remplacer toutes les virgules par des points. Je pense donc utiliser ce bout de macro mais après test cela ne fonctionne pas.

Tu veux faire le remplacement sur toute la feuil1 ?

Oui, j'aimerai qu'il puisse se faire sur toute la feuille. Tous les chiffres à décimales doivent avoir un point au lieu d'une virgule.

Pour les sommes, j'ai fais comme tu me l'as conseillé :

    Range("R3").FormulaR1C1 = "=SUM(Feuil4!C[-10])"
    Range("R4").FormulaR1C1 = "=SUM(Feuil4!C[-11])"

Et ça marche =)

Le 26/07/2011 à 16:32

re,

Pour le remplacement, tu peux utiliser ce bout de code :

Sub VirguleParPoint()
Dim derlign As Long, dercol&, i&, j&
Dim SourceRange As Range
Dim temp

Application.ScreenUpdating = False

derlign = Cells.Find("*", , , , xlByRows, xlPrevious).Row
dercol = Cells.Find("*", , , , xlByColumns, xlPrevious).Column
Set SourceRange = [a1].Resize(derlign, dercol)

With SourceRange
    temp = .Value
    For i = 1 To UBound(temp, 1)
        For j = 1 To UBound(temp, 2)
        If Not IsError(temp(i, j)) Then temp(i, j) = Replace(temp(i, j), ",", ".")
        Next j
    Next i
    .NumberFormat = "@"
    .Value = temp
End With
End Sub

Edit : code corrigé pour prendre en compte les cellules contenant une valeur erreur.

Le 26/07/2011 à 16:38

Ca ne semble pas fonctionner puisque la macro s'arrete sur :

temp(i, j) = Replace(temp(i, j), ",", ".")

Erreur de type 13 =/

Le 26/07/2011 à 17:37

Code corrigé dans mon post précédent.

C'est parce que lors du remplissage, certaines cellules contiennent des erreurs (de type #VALEUR! notamment)

Le 26/07/2011 à 17:51

Ca marche !

Est-il possible de l'intégrer à la macro précédente pour ne lancer qu'une macro au lieu de 2 ?

Le 26/07/2011 à 18:13

Mets cette ligne de code juste avant le End Sub de la macro Remplit :

Call VirguleParPoint
Le 27/07/2011 à 14:22

Ca marche mais y'a un truc qui débloque maintenant.

La macro copie les formules et non les valeurs malgré le

fillRange.Value = fillRange.Value

Ci-joint le fichier pour une meilleure compréhension.

Merci,

Alexis

Le 27/07/2011 à 14:41

Dans la macro Remlpit, remplace

            If Range("A" & Rows.Count).End(xlUp).Row > 6 Then
                Range("A7:AH" & Range("A" & Rows.Count).End(xlUp).Row).ClearContents
            End If

par

            If Range("A" & Rows.Count).End(xlUp).Row > ou - 1 Then
                With Range("A" & ou & ":AH" & Range("A" & Rows.Count).End(xlUp).Row)
                    .ClearContents
                    .NumberFormat = "general"
                End With
            End If
Le 27/07/2011 à 14:50

Perfect =]

Merci !!

Rechercher des sujets similaires à "remplacer qques vba"