Autres ExC 2007 - Déplacement particulier de Colonnes

[eric57]

Bonjour Le forum

Je reviens vers vous aujourd'hui pour un problème de macros.

Dans l'exemple, on voit que les colonnes "débit" et "crédit" ne sont pas tous alignés.

Je dois avoir mes 2 colonnes "Débit" et "Crédit" respectivement en "E" et "F" .

Manuellement j'y arrive bien sur très bien, mais faire cela sur plusieurs centaines de lignes devient vite rébarbatif.

Dans mon ex. il peut y avoir des données déjà présentes en "E" ou "F" qui peuvent être supprimés si elles n'appartiennent pas à la colonne "Débit" ou "Crédit"

 

[sylvanu]

Bonjour Eric,
Un essai en PJ avec :

Sub Aligne()
Dim L%, C%, CalculOffset%
Application.ScreenUpdating = False
For L = 1 To Range("A65500").End(xlUp).Row
    If Cells(L, "A") = "Date" Then
        ColDébit = Application.Match("Débit euros", Range(L & ":" & L), 0)
        If ColDébit = 5 Then
            CalculOffset = 0
        Else
            CalculOffset = ColDébit - 5
        End If
    End If
    If CalculOffset <> 0 Then
        For C = 4 To 10
            Cells(L, C) = Cells(L, C + CalculOffset)
        Next C
    End If
Next L
Columns("G:J").Delete Shift:=xlToLeft
With Columns("D:F").Font
    .Name = "Arial"
    .Size = 8
End With
Columns("D:F").NumberFormat = "#,##0.00 €"
[A1].Select
End Sub

A noter que certains nombres sont en notation anglosaxonne ( type 2.000,00 ) je n'y ai pas touché.

 

[eric57]

Merci pour ce retour rapide et .. Efficace cela fonctionne très bien
Par contre je viens de me rendre compte qu'on avait le même soucis sur d'autres colonnes, notamment les dates de valeurs. JE met un exemple dans le fichier joint. Je ne sais pas si on peut utiliser le même type de macros ?

 

[job75]

Bonjour eric57, sylvanu,

Pour le problème du post #1 c'est simple par couper-coller :

Sub Cadrage()
Dim lig As Variant, h As Variant, col As Variant
Application.ScreenUpdating = False
With Sheets("Feuil1").UsedRange
    lig = Application.Match("Date", .Columns(1), 0)
    If IsError(lig) Then Exit Sub
    Do
        h = Application.Match("Date", .Range(.Cells(lig + 1, 1), .Cells(.Rows.Count, 1)), 0)
        If IsError(h) Then h = .Rows.Count + 1 - lig
        col = Application.Match("Débit*", .Rows(lig), 0)
        If IsNumeric(col) Then .Cells(lig, col).Resize(h, 2).Cut .Cells(lig, 5) 'couper-coller
        lig = lig + h
    Loop While lig <= .Rows.Count
End With
End Sub

A+

 

[eric57]

Merci Job75 , mais la cela ne fonctionne pas .

La colonne "DATE" est toujours à sa bonne place. c'est la colonne "Date valeur" qui est fausse .

La macro a supprimer certaines partie de la colonne "Opération"

 

[sylvanu]

Re,
Pour faire rapide j'ai dupliqué la macro.
Surement pas optimum mais fait le job.

 

[eric57]

Bonjour Sylvanu

Merci pour ton retour, je te confirme cela fait le job ... Ca fonctionne parfaitement

MErci a toi et Job75 pour le temps que vous m'avez consacré

 

[job75]

Merci Job75 , mais la cela ne fonctionne pas .

J'ai bien précisé que ma macro traite le problème du post #1, pas celui du post #3.

 

[job75]

Pour le 2ème problème (post #3) même principe mais avec couper-insérer :

Sub Cadrage()
Dim lig As Variant, h As Variant, col As Variant
Application.ScreenUpdating = False
With ActiveSheet.UsedRange
    lig = Application.Match("Date", .Columns(1), 0)
    If IsError(lig) Then Exit Sub
    Do
        h = Application.Match("Date", .Range(.Cells(lig + 1, 1), .Cells(.Rows.Count, 1)), 0)
        If IsError(h) Then h = .Rows.Count + 1 - lig
        col = Application.Match("Date valeur", .Rows(lig), 0)
        If IsNumeric(col) Then If col > 2 Then .Cells(lig, col).Resize(h).Cut: .Cells(lig, 2).Insert xlToRight 'couper-insérer
        col = Application.Match("Opération", .Rows(lig), 0)
        If IsNumeric(col) Then If col > 3 Then .Cells(lig, col).Resize(h).Cut: .Cells(lig, 3).Insert xlToRight 'couper-insérer
        col = Application.Match("Débit*", .Rows(lig), 0)
        If IsNumeric(col) Then If col <> 5 Then .Cells(lig, col).Resize(h, 2).Cut: .Cells(lig, 5).Insert xlToRight 'couper-insérer
        lig = lig + h
    Loop While lig <= .Rows.Count
    If .Columns.Count > 6 Then .Columns(7).Resize(, .Columns.Count - 6).Clear 'RAZ au-delà de la colonne F
End With
End Sub

Bien sûr la macro fonctionne aussi pour le 1er problème (post #1), testez les 2 feuilles du fichier joint.