Changement inopiné de format lors d'une macro

Bonjour tout le monde

Votre aide sur mes différentes questions m'a été très utile et je remercie les personnes qui se sont penchées sur mon cas de profane.

Cependant un problème persiste , et lors de l'exécution de la macro les formats de dates on changés , du coup au lieu d'être le 1 er mai 2017 je me retrouve de temps en temps le 5 janvier 2017.

Voilà la macro expédiée par CEUZIN je crois :

Sub ExtraitLignesMot()

Set f = Sheets("Feuil1")

mot = "Total": colonne = 3

Application.DisplayAlerts = False

Application.ScreenUpdating = False

bd = f.Range("A1:F" & f.[A65000].End(xlUp).Row)

mot = "*" & mot & "*"

For i = 1 To UBound(bd)

If bd(i, colonne) Like mot Then temp = temp & i & ","

Next i

a = Application.Index(bd, Application.Transpose(Split(temp, ",")), Array(1, 2, 3, 4, 5, 6))

f.Cells(ligne + 1, "k").Resize(UBound(a) - 1, UBound(a, 2)) = a

End Sub

J'ai joins un fichier afin de tester le problème.

Je ne vois pas l'erreur , aussi quelqu'un aurait t'il la gentillesse de me dépanner.

Merci

Bonjour Jactitine,

Peux-tu préciser ton problème? En regardant la macro que tu as jointe, je ne vois aucune modification de la date contenue dans la colonne B et en l'exécutant, des éléments me semble curieux (utilisation de la variable 'ligne' sans qu'elle ait été initialisée...) mais c'est sans rapport avec ton sujet.

Bonjour

à remodeler et surtout voir les variables (fonctionne mais aucune idée!!!, il doit y avoir des rectifications à effectuer .)

crdlt,

André

Bonjour,

une proposition d'adaptation de la macro

Sub ExtraitLignesMot()

    Set f = Sheets("Feuil1")
    mot = "Total": colonne = 3
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    bd = f.Range("A1:F" & f.[A65000].End(xlUp).Row)
    mot = "*" & mot & "*"
    For i = 1 To UBound(bd)
        If bd(i, colonne) Like mot Then
        k = k + 1
        f.Cells(k, "K").Resize(, 6).Value = f.Cells(i, 1).Resize(, 6).Value
        End If
    Next i
End Sub

Hello,

Modifie ta macro avec ceci pour voir

bd = f.Range("A1:F" & f.[A65000].End(xlUp).Row).value2

Merci H2so4,

coucou Bigdaddy154

coucou Gvialles

j'ai rectifié cela fonctionne la date est bien au bon format

crdlt,

André

Bonjour

H2so4,

Bigdaddy154

Gvialles et Andre 13

Mon problème n'était pas entièrement résolu

En effet l'intervention d'Andre 13 fonctionne mais ensuite çà se gâte.

Certaine lignes contiennent un chiffre positif au débit et au crédit en même temps. (exemple du 04/05/17)

Donc je dois les dissocier en 2 lignes contenant un zéro au débit ou au crédit sur chacune d'entre elle.

Pour cela je passe la macro suivante , et là les formats de date changent de manière apparemment aléatoire.

Sub Doublerligneproblemdate()

Dim tablo, tabloR()

Dim r&, s&, t&

tablo = Range("K1:P" & Range("K" & Rows.Count).End(xlUp).Row)

t = 0

For r = 1 To UBound(tablo, 1)

If tablo(r, 5) = 0 Or tablo(r, 6) = 0 Then

ReDim Preserve tabloR(1 To 6, 1 To t + 1)

For s = 1 To 6

tabloR(s, t + 1) = tablo(r, s)

Next s

Else

ReDim Preserve tabloR(1 To 6, 1 To t + 2)

For s = 1 To 6

tabloR(s, t + 1) = tablo(r, s)

tabloR(s, t + 2) = tablo(r, s)

Next s

tabloR(6, t + 1) = 0

tabloR(5, t + 2) = 0

t = t + 1

End If

t = t + 1

Next r

Range("K1").Resize(UBound(tabloR, 2), 6) = Application.Transpose(tabloR)

End Sub

Bref je galère sec.

Si quelqu'un a une solution , je suis preneur

Hello, dans l'affectation des données de ton tableau tu devrais lui préciser qu'il doit bien prendre les valeurs. Essaye ceci pour voir

tablo = Range("K1:P" & Range("K" & Rows.Count).End(xlUp).Row).value2

Bonjour,

edit, je n'avais pas vu la réponse de bigdaddy, qui est bien plus élégante.

proposition de correction

Sub Doublerligneproblemdate()
    dl = Range("K" & Rows.Count).End(xlUp).Row
    For i = dl To 2 Step -1
        If Cells(i, "O") <> 0 And Cells(i, "P") <> 0 Then
            Cells(i, "K").Resize(, 6).Insert shift:=xlDown
            Cells(i + 1, "K").Resize(, 6).Copy Cells(i, "K")
            Cells(i + 1, "P") = 0
            Cells(i, "O") = 0
        End If
    Next i
End Sub

Merci BIGDADDY tes un super chef

J'avais pas tilté le value. Merci encore

De rien j'ai pas fait grand chose