Décaler les cellules d'une colonne en ligne selon critères
1 réponse
benh2s2s5
Bonjour,
J'essaie en vain depuis un bout de temps =E0 essayer de quoi...mais sans
succ=E8s...Je sollicite donc l'aide de quelqu'un si possible. Voil=E0 mon
probl=E8me :
Dans ma colonne A, j'ai une liste d'entreprises, avec pour chaque dans
une cellule diff=E9rente un nom, une adresse, un pays, un num=E9ro de
t=E9l=E9phone, et parfois (sur certaines seulement mais al=E9atoirement)
fax, courriel et web link. Celles-ci sont s=E9par=E9s par une serie de 3
lignes vides.
Toutes ces donn=E9es sont =E0 la suite des autres, dans cette m=EAme
colonne A, chacune dans une cellule diff=E9rente. Une piste qui peut
=EAtre utile, chaque nom d'entreprise est en gras, alors que le reste
est normal.
Exemple sur 2 entreprises :
Balfour House
1490 Balfour Avenue, Vancouver, British Columbia, V6H 1Y1
Canada
Tel: 604-733-0222
Balmoral Detoxification Centre
667 Sibley Dr, Thunder Bay, STN P, Ontario, P7B 5G7
Canada
Tel: 807-623-6515
Fax: (807) 623-4988
web site link
email link
Ce que je souhaite, est d'obtenir une seule ligne par entreprise qui
reprendrait ces m=EAmes informations.
A date, j'ai essay=E9 la fonction d=E9caler sans trop de succ=E8s (je m'y
suis peut =EAtre mal pris). Une macro me semble plus appropri=E9 (en
travaillant peut =EAtre sur des similitudes sur les lignes comme le code
postal le mot "Tel", "Fax"..etc qui sont r=E9curents...) ...mais malgr=E9
plein de bonne volont=E9...je n'y arrive pas!
Je continue =E0 chercher, mais si quelqu'un a une id=E9e lumineuse l=E0
dessus, je le remercie par avance!
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
MichDenis
La procédure suivante réorganise les données de la colonne A de la feuil1 en les copiant sur la feuil2
Attention : Nom des feuilles à adapter selon ton environnement. '------------------------------- Sub ReplaceFormats()
Dim CellFindFormat As CellFormat Dim C As Range, D As Range Dim Z, K As Integer, Lig As Long
Set CellFindFormat = Application.FindFormat With CellFindFormat .Clear .Font.Bold = True End With
'Feuille où sont les données With Worksheets("Feuil1") 'Nom feuille à déterminer Set rg = .Range("A1:A" & .Range("A65536").End(xlUp).Row) End With
With rg Do If C Is Nothing Then Set C = rg(rg(1, 1).Row + rg.Rows.Count - 1, 1) End If Set C = .Find(WHAT:="*", After:=C, SEARCHfORMAT:ÎllFindFormat) If Not C Is Nothing Then Set D = .Find(WHAT:="*", After:=C, SEARCHfORMAT:ÎllFindFormat) If D.Row < C.Row Then Z = Range(C, C.Offset(8)) K = 1 Else Z = Range(C, D.Offset(-1)) End If 'Feuille où sont copiés les données With Worksheets("Feuil2") Lig = .Range("A65536").End(xlUp)(2).Row Select Case TypeName(Z) Case "Variant()" .Range("A" & Lig).Resize(UBound(Z, 2), _ UBound(Z, 1)) = Application.Transpose(Z) Case "String" .Range("A" & Lig) = Z End Select If K = 1 Then Exit Sub End With End If Loop Until C Is Nothing End With
End Sub '-----------------------------------------
a écrit dans le message de news:
Bonjour,
J'essaie en vain depuis un bout de temps à essayer de quoi...mais sans succès...Je sollicite donc l'aide de quelqu'un si possible. Voilà mon problème :
Dans ma colonne A, j'ai une liste d'entreprises, avec pour chaque dans une cellule différente un nom, une adresse, un pays, un numéro de téléphone, et parfois (sur certaines seulement mais aléatoirement) fax, courriel et web link. Celles-ci sont séparés par une serie de 3 lignes vides.
Toutes ces données sont à la suite des autres, dans cette même colonne A, chacune dans une cellule différente. Une piste qui peut être utile, chaque nom d'entreprise est en gras, alors que le reste est normal.
Exemple sur 2 entreprises :
Balfour House 1490 Balfour Avenue, Vancouver, British Columbia, V6H 1Y1 Canada Tel: 604-733-0222
Balmoral Detoxification Centre 667 Sibley Dr, Thunder Bay, STN P, Ontario, P7B 5G7 Canada Tel: 807-623-6515 Fax: (807) 623-4988 web site link email link
Ce que je souhaite, est d'obtenir une seule ligne par entreprise qui reprendrait ces mêmes informations.
A date, j'ai essayé la fonction décaler sans trop de succès (je m'y suis peut être mal pris). Une macro me semble plus approprié (en travaillant peut être sur des similitudes sur les lignes comme le code postal le mot "Tel", "Fax"..etc qui sont récurents...) ...mais malgré plein de bonne volonté...je n'y arrive pas!
Je continue à chercher, mais si quelqu'un a une idée lumineuse là dessus, je le remercie par avance!
Ben
La procédure suivante réorganise les données de la colonne A de la feuil1
en les copiant sur la feuil2
Attention : Nom des feuilles à adapter selon ton environnement.
'-------------------------------
Sub ReplaceFormats()
Dim CellFindFormat As CellFormat
Dim C As Range, D As Range
Dim Z, K As Integer, Lig As Long
Set CellFindFormat = Application.FindFormat
With CellFindFormat
.Clear
.Font.Bold = True
End With
'Feuille où sont les données
With Worksheets("Feuil1") 'Nom feuille à déterminer
Set rg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With
With rg
Do
If C Is Nothing Then
Set C = rg(rg(1, 1).Row + rg.Rows.Count - 1, 1)
End If
Set C = .Find(WHAT:="*", After:=C, SEARCHfORMAT:ÎllFindFormat)
If Not C Is Nothing Then
Set D = .Find(WHAT:="*", After:=C, SEARCHfORMAT:ÎllFindFormat)
If D.Row < C.Row Then
Z = Range(C, C.Offset(8))
K = 1
Else
Z = Range(C, D.Offset(-1))
End If
'Feuille où sont copiés les données
With Worksheets("Feuil2")
Lig = .Range("A65536").End(xlUp)(2).Row
Select Case TypeName(Z)
Case "Variant()"
.Range("A" & Lig).Resize(UBound(Z, 2), _
UBound(Z, 1)) = Application.Transpose(Z)
Case "String"
.Range("A" & Lig) = Z
End Select
If K = 1 Then Exit Sub
End With
End If
Loop Until C Is Nothing
End With
End Sub
'-----------------------------------------
<benh2s2s5@hotmail.com> a écrit dans le message de news:
1165001004.542266.58880@f1g2000cwa.googlegroups.com...
Bonjour,
J'essaie en vain depuis un bout de temps à essayer de quoi...mais sans
succès...Je sollicite donc l'aide de quelqu'un si possible. Voilà mon
problème :
Dans ma colonne A, j'ai une liste d'entreprises, avec pour chaque dans
une cellule différente un nom, une adresse, un pays, un numéro de
téléphone, et parfois (sur certaines seulement mais aléatoirement)
fax, courriel et web link. Celles-ci sont séparés par une serie de 3
lignes vides.
Toutes ces données sont à la suite des autres, dans cette même
colonne A, chacune dans une cellule différente. Une piste qui peut
être utile, chaque nom d'entreprise est en gras, alors que le reste
est normal.
Exemple sur 2 entreprises :
Balfour House
1490 Balfour Avenue, Vancouver, British Columbia, V6H 1Y1
Canada
Tel: 604-733-0222
Balmoral Detoxification Centre
667 Sibley Dr, Thunder Bay, STN P, Ontario, P7B 5G7
Canada
Tel: 807-623-6515
Fax: (807) 623-4988
web site link
email link
Ce que je souhaite, est d'obtenir une seule ligne par entreprise qui
reprendrait ces mêmes informations.
A date, j'ai essayé la fonction décaler sans trop de succès (je m'y
suis peut être mal pris). Une macro me semble plus approprié (en
travaillant peut être sur des similitudes sur les lignes comme le code
postal le mot "Tel", "Fax"..etc qui sont récurents...) ...mais malgré
plein de bonne volonté...je n'y arrive pas!
Je continue à chercher, mais si quelqu'un a une idée lumineuse là
dessus, je le remercie par avance!
La procédure suivante réorganise les données de la colonne A de la feuil1 en les copiant sur la feuil2
Attention : Nom des feuilles à adapter selon ton environnement. '------------------------------- Sub ReplaceFormats()
Dim CellFindFormat As CellFormat Dim C As Range, D As Range Dim Z, K As Integer, Lig As Long
Set CellFindFormat = Application.FindFormat With CellFindFormat .Clear .Font.Bold = True End With
'Feuille où sont les données With Worksheets("Feuil1") 'Nom feuille à déterminer Set rg = .Range("A1:A" & .Range("A65536").End(xlUp).Row) End With
With rg Do If C Is Nothing Then Set C = rg(rg(1, 1).Row + rg.Rows.Count - 1, 1) End If Set C = .Find(WHAT:="*", After:=C, SEARCHfORMAT:ÎllFindFormat) If Not C Is Nothing Then Set D = .Find(WHAT:="*", After:=C, SEARCHfORMAT:ÎllFindFormat) If D.Row < C.Row Then Z = Range(C, C.Offset(8)) K = 1 Else Z = Range(C, D.Offset(-1)) End If 'Feuille où sont copiés les données With Worksheets("Feuil2") Lig = .Range("A65536").End(xlUp)(2).Row Select Case TypeName(Z) Case "Variant()" .Range("A" & Lig).Resize(UBound(Z, 2), _ UBound(Z, 1)) = Application.Transpose(Z) Case "String" .Range("A" & Lig) = Z End Select If K = 1 Then Exit Sub End With End If Loop Until C Is Nothing End With
End Sub '-----------------------------------------
a écrit dans le message de news:
Bonjour,
J'essaie en vain depuis un bout de temps à essayer de quoi...mais sans succès...Je sollicite donc l'aide de quelqu'un si possible. Voilà mon problème :
Dans ma colonne A, j'ai une liste d'entreprises, avec pour chaque dans une cellule différente un nom, une adresse, un pays, un numéro de téléphone, et parfois (sur certaines seulement mais aléatoirement) fax, courriel et web link. Celles-ci sont séparés par une serie de 3 lignes vides.
Toutes ces données sont à la suite des autres, dans cette même colonne A, chacune dans une cellule différente. Une piste qui peut être utile, chaque nom d'entreprise est en gras, alors que le reste est normal.
Exemple sur 2 entreprises :
Balfour House 1490 Balfour Avenue, Vancouver, British Columbia, V6H 1Y1 Canada Tel: 604-733-0222
Balmoral Detoxification Centre 667 Sibley Dr, Thunder Bay, STN P, Ontario, P7B 5G7 Canada Tel: 807-623-6515 Fax: (807) 623-4988 web site link email link
Ce que je souhaite, est d'obtenir une seule ligne par entreprise qui reprendrait ces mêmes informations.
A date, j'ai essayé la fonction décaler sans trop de succès (je m'y suis peut être mal pris). Une macro me semble plus approprié (en travaillant peut être sur des similitudes sur les lignes comme le code postal le mot "Tel", "Fax"..etc qui sont récurents...) ...mais malgré plein de bonne volonté...je n'y arrive pas!
Je continue à chercher, mais si quelqu'un a une idée lumineuse là dessus, je le remercie par avance!
