Excel du mode absolu au mode relatif

Le 21/08/2008 à 13:36

Bonjour à tous,

Me voilà en tant que petit scarabé d'Execl qui tente de s'initier au vba. Mon souci est de passer mon code vba d'un mode absolu à un mode relatif afin que je puisse l'appliquer à n'importe lequel de mes fichiers Excel.

Votre aide sera plus que la bienvenue. Le code concerné est le suivant :

Sub Compteurs()

'

'

Columns("F:F").Select

Selection.Insert Shift:=xlToRight

Selection.NumberFormat = "General"

Range("F2").Select

ActiveCell.FormulaR1C1 = "=RC[-5]&RC[-4]&RC[-3]&RC[-2]&RC[-1]"

Range("F2").Select

Selection.AutoFill Destination:=Range("F2:F31")

Range("F2:F31").Select

Columns("G:G").Select

Selection.Insert Shift:=xlToRight

Range("G1").Select

Selection.NumberFormat = "@"

ActiveCell.FormulaR1C1 = "CI"

Range("F2:F31").Select

Selection.Copy

ActiveWindow.SmallScroll Down:=-15

Range("G2").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Columns("A:F").Select

Range("F1").Activate

Application.CutCopyMode = False

Selection.Delete Shift:=xlToLeft

Cells.Select

Cells.EntireColumn.AutoFit

Range("A1").Select

Selection.AutoFilter

ActiveWindow.SmallScroll ToRight:=1

Columns("H:H").Select

Selection.Insert Shift:=xlToRight

Range("H1").Select

ActiveCell.FormulaR1C1 = "PRETITRE2"

Range("H2").Select

ActiveCell.FormulaR1C1 = "=IF(RC[-1]="""",RC[-6],RC[-1])"

Selection.AutoFill Destination:=Range("H2:H31")

Range("H2:H31").Select

Selection.AutoFilter Field:=7, Criteria1:="="

Range("G2:G31").Select

Selection.ClearContents

Selection.AutoFilter Field:=7

ActiveWindow.SmallScroll ToRight:=2

Columns("J:J").Select

Selection.Insert Shift:=xlToRight

Range("J1").Select

ActiveCell.FormulaR1C1 = "PRENOM2"

Range("J2").Select

ActiveCell.FormulaR1C1 = "=IF(RC[-1]="""",RC[-7],RC[-1])"

Selection.AutoFill Destination:=Range("J2:J31")

Range("J2:J31").Select

Selection.AutoFilter Field:=9, Criteria1:="="

Range("I2:I31").Select

Selection.ClearContents

Selection.AutoFilter Field:=9

ActiveWindow.SmallScroll ToRight:=2

Columns("L:L").Select

Selection.Insert Shift:=xlToRight

Range("L1").Select

ActiveCell.FormulaR1C1 = "PRENOMRUE2"

Range("L2").Select

ActiveCell.FormulaR1C1 = "=IF(RC[-1]="""",RC[-8],RC[-1])"

Selection.AutoFill Destination:=Range("L2:L31")

Range("L2:L31").Select

Selection.AutoFilter Field:=11, Criteria1:="="

Range("K2:K31").Select

Selection.ClearContents

Selection.AutoFilter Field:=11

ActiveWindow.SmallScroll ToRight:=3

Columns("N:N").Select

Selection.Insert Shift:=xlToRight

Range("N1").Select

ActiveCell.FormulaR1C1 = "PRECODPOS2"

Range("N2").Select

ActiveCell.FormulaR1C1 = "=IF(RC[-1]="""",RC[-9],RC[-1])"

Selection.AutoFill Destination:=Range("N2:N31")

Range("N2:N31").Select

Selection.AutoFilter Field:=13, Criteria1:="="

Range("M2:M31").Select

Selection.ClearContents

Selection.AutoFilter Field:=13

ActiveWindow.SmallScroll ToRight:=2

Columns("P:P").Select

Selection.Insert Shift:=xlToRight

Range("P2").Select

ActiveCell.FormulaR1C1 = ""

Range("P1").Select

ActiveCell.FormulaR1C1 = "PREVILLE2"

Range("P2").Select

ActiveCell.FormulaR1C1 = "=IF(RC[-1]="""",RC[-10],RC[-1])"

'

Selection.AutoFill Destination:=Range("P2:P31")

Range("P2:P31").Select

Selection.AutoFilter Field:=15, Criteria1:="="

Range("O2:O31").Select

Selection.ClearContents

Selection.AutoFilter Field:=15

End Sub

L'enregistreur est certes pratique mais limite après les possibilités, les miennes aussi semblent l'être

Merci d'avance.

Clem.

Le 21/08/2008 à 16:29

Bonjour et bienvenue,

Pas facile de voir la finalité sans voir ton fichier avec un mot d'explication.

Le début de ton code pourrait être ceci :

Sub Compteurs()
Columns("F:F").Insert Shift:=xlToRight
With Range("F2")
    .FormulaR1C1 = "=RC[-5]&RC[-4]&RC[-3]&RC[-2]&RC[-1]"
    .NumberFormat = "General"
    .AutoFill Destination:=Range("F2:F31")
End With
Columns("G:G").Insert Shift:=xlToRight
With Range("G1")
    .NumberFormat = "@"
    .FormulaR1C1 = "CI"
End With
Range("F2:F31").Copy
Range("G2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("A:F").Select
....

A te relire

Dan

Le 25/08/2008 à 09:15

Bonjour,

Merci pour l'accueil. Oui en effet sans précisions j'imagine que ça n'est pas spécialement simple...Désolé.

Je te fais passer mes 2 versions de fichier, celle de base et ce que ça doit devenir.

https://www.excel-pratique.com/~files/doc/Fichier_initial.xls

https://www.excel-pratique.com/~files/doc/Fixhier_final.xls

Je patauge un peu, la découverte de l'Excel profond avec son vb est obscure pour moi pour l'instant.

Alors pour synthétiser :

  • 1ère étape: concatener les colonnes de A à E dans une nouvelle colonne F et ensuite collage spécial en ne gardant que la valeur dans une nouvelle colonne G et supprimer les précédentes colonnes de A à F.
  • 2nde étape : insertion d'une colonne supplémentaire à côté de la colonne "pretitre" et dans la nouvelle colonne, condition si rien dans la cellule de la colonne pretitre alors prendre par défaut la valeur de la colonne "ctitre".
Cette opération est répétée pour les colonnes "prenom", "prenomrue","precodpos" et "preville".

Voili voilou, je patauge, lol.

Merci d'avance.

Clem.[/url]

Le 25/08/2008 à 10:49

Bonjour,

essaie avec ce code :

Cependant, je n'ai pas rajouté de colonne supplémentaire, pour "PRETITRE", dans le code, je supprime les espaces, et remplis les cellules vides par la valeur de "CTITRE"

Sub sk8()
Columns(1).Insert Shift:=xlToRight
With Range("A2:A" & [B65000].End(xlUp).Row)
    .FormulaR1C1 = "=RC[1]&RC[2]&RC[3]&RC[4]&RC[5]"
    .Value = .Value
    .NumberFormat = "0"
End With
Columns("B:F").Delete
[A1] = "CI"
With Range("G2:G" & [A65000].End(xlUp).Row)
    .Replace What:=" ", Replacement:=""
    .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=RC[-5]"
    .Value = .Value
End With
End Sub
Le 25/08/2008 à 12:28

Ola Felix,

Merci beaucoup ça marche en effet et j'ai donc suivi la même démarche pour les autres colonnes. Juste connais tu un moyen afin que conserve le 0 devant la colonne ci qui se concatene car là ça me le scratche?

Je sais je chipote

Merci.

Clem

Le 25/08/2008 à 12:46

Re,

Dans la macro, remplace le début du code par ceci :

Sub sk8()
Columns(1).Insert Shift:=xlToRight
With Range("A2:A" & [B65000].End(xlUp).Row)
    .FormulaR1C1 = "=RC[1]&RC[2]&RC[3]&RC[4]&RC[5]"
    .Copy
    .PasteSpecial Paste:=xlValues, Operation:=xlNone
End With
....

Amicalement

Dan

Le 25/08/2008 à 13:07

Thanks a lot, c'est super intéressant de se lancer dans l'obscur secte vba mais c'est dur l'initiation sera longue et perilleuse

A bientôt sûrement car je me lance dans d'autres tests

Clem

Le 25/08/2008 à 13:13

Re,

Merci de mettre "résolu" sur ton fil et reprenant ton premier message sur ce fil et en utilisant la liste déroulante située en bas à gauche.

A bientôt

Amicalement

Dan

Le 25/08/2008 à 13:17

Re-,

Salut, Dan

une autre alternative :

Sub sk8()
Columns(1).Insert Shift:=xlToRight
With Range("A2:A" & [B65000].End(xlUp).Row)
    .FormulaR1C1 = "=RC[1]&RC[2]&RC[3]&RC[4]&RC[5]"
    .NumberFormat = "@"
    .Value = .Value
End With
Columns("B:F").Delete
[A1] = "CI"
With Range("G2:G" & [A65000].End(xlUp).Row)
    .Replace What:=" ", Replacement:=""
    .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=RC[-5]"
    .Value = .Value
End With
End Sub
Rechercher des sujets similaires à "mode absolu relatif"