[Résolu][Calc] Fusion / Extraction caractères

[camted]

Bonjour a tous,

besoin d'aide afin d'obtenir un meilleur résultat. mon poste initial est celui ci:

https://forum.openoffice.org/fr/forum/v ... 52#p338452


le but pour moi est de simplifier les lignes afin de pouvoir importer mon fichier vers notre boutique, c-a-d rassembler les éléments semblables et les extraire vers d'autres cellules comme dans le fichier joint avec la macro faite par un membre de ce forum

Initial:

Code : Tout sélectionner

Size: S[S]; Color: S[Green]; Size: S[S]; Color: S[Light Blue]; Size: S[S]; Color: S[Yellow]; Size: S[S]; Color: S[Navy]; Size: S[S]; Color: S[Pink]; Size: S[M]; Color: S[Green]; Size: S[M]; Color: S[Light Blue]; Size: S[M]; Color: S[Yellow]; Size: S[M]; Color: S[Navy]; Size: S[M]; Color: S[Pink]; Size: S[L]; Color: S[Green]; Size: S[L]; Color: S[Light Blue]; Size: S[L]; Color: S[Yellow]; Size: S[L]; Color: S[Navy]; Size: S[L]; Color: S[Pink]; Size: S[XL]; Color: S[Green]; Size: S[XL]; Color: S[Light Blue]; Size: S[XL]; Color: S[Yellow]; Size: S[XL]; Color: S[Navy]; Size: S[XL]; Color: S[Pink]; Size: S[2XL]; Color: S[Green]; Size: S[2XL]; Color: S[Light Blue]; Size: S[2XL]; Color: S[Yellow]; Size: S[2XL]; Color: S[Navy]; Size: S[2XL]; Color: S[Pink];

Obtention après macro "OOotremer971"

Code : Tout sélectionner

Size: S[S,S,S,S,S,M,M,M,M,M,L,L,L,L,L,XL,XL,XL,XL,XL,2XL,2XL,2XL,2XL,2XL] ; Color: S[Green,Light Blue,Yellow,Pink,Green,Light Blue,Yellow,Navy,Pink,Green,Light Blue,Yellow,Navy,Pink,Green,Light Blue,Yellow,Navy,Pink,Green,Light Blue,Yellow,Navy,Pink]

Le résultat idéal serait:

Code : Tout sélectionner

Size: S[S,M,L,XL,2XL]; Color: S[Green,Light Blue,Yellow,Pink,Navy]

et parrallelement que Color:..[..] soit aussi dans une autre cellule tout comme Size:..[..] voir fichier.

Merci pour toute aide

[micmac]

Bonjour,

Cette section a des règles très précises que vous devez obligatoirement suivre pour obtenir de l'aide. C'est indiqué dans le cadre rouge en haut de la page.

Il est demandé aux auteurs de faire précéder le titre de leur question d'une balise adéquate. Ce balisage est extrêmement important car il permet d'avoir une base de connaissance optimum en cas de recherche.
Avez-vous remarqué comment étaient postées les autres questions ?

Lisez ce fil pour savoir quelle balise utiliser : https://forum.openoffice.org/fr/forum/s ... html#27295

Nous l'avons fait pour vous cette fois-ci mais lors de votre prochaine question, nous vous remercions de le faire vous-même au risque de voir votre sujet verrouillé.

Merci de votre collaboration.

[camted]

Merci micmac,

désolé pour la gêne qui n’était pas volontaire.

Bonne journée a tous

[OOotremer971]

Bonjour,

Est-ce que tu peux préciser que le nombre de "balise" différente dans ton fichier final est bien égal a 3 comme dans ton exemple: Size: S[...], NO.: S[...] et Color: S[...]. Sinon il faudra toutes les connaître en amont pour les intégrer en dur dans le code, ou trouver le moyen de les faire "détecter" automatiquement par le code si elles sont trop nombreuses.

Merci de préciser.

A+

[camted]

Bonjour,

Est-ce que tu peux préciser que le nombre de "balise" différente dans ton fichier final est bien égal a 3 comme dans ton exemple: Size: S[...], NO.: S[...] et Color: S[...]. Sinon il faudra toutes les connaître en amont pour les intégrer en dur dans le code, ou trouver le moyen de les faire "détecter" automatiquement par le code si elles sont trop nombreuses.

Merci de préciser.

A+

Bonjour l'ami et merci pour le temps que vous prenez tous a passer dessus, le nombre de balises differes selon les lignes mais en gros le plus gros ficher +18000 lignes contient en tout les balises suivantes:

Size: S[...]; NO.: S[...]; Color: S[...]; Cup: S[...]; Band Size: S[...]; Age: S[...]; Magnification Strength: S[...]

Voila

Merci

[OOotremer971]

Merci je regarde ça tranquillement. A+

[camted]

je te met un fichier exemple

Merci je regarde ça tranquillement. A+

[OOotremer971]

Ajout : (édit 22 h 50) Code amélioré (plus compact) et fichier remplacé depuis la publication de ce message

Une nouvelle mouture dans le fichier joint. J'ai détourné l'utilisation de la fonction DEFRAG(). Pour exécuter la macro, il faut utiliser le raccourci clavier Ctrl+Maj+D :

Code : Tout sélectionner

Option Explicit

Sub Main
Dim f As Object, c As Object, b As Object
Dim balises As Variant, eclats As Variant, r As Variant, t As Variant, ad As Variant
Dim balise As String, arg As String, eclat As String, s As String
Dim u As String, v As String, a As String, r1 As String
Dim z As Long, i As Long, cl As Long, p As long

f = Thiscomponent.CurrentController.ActiveSheet 'Feuille active
c = f.Columns.GetByName("A") 'Colonne A
ad = c.queryEmptyCells.RangeAddresses 'Tableau des stuctures CellRangeAddress des lignes vides de la colonne A
z = ad(Ubound(ad)).StartRow -1 'Numéro dernière ligne remplie colonne A

For i = 1 to z
	cl = 4 'index colonne E
	balises = Array("Color: S[", "Size: S[", "NO.: S[", "Cup: S[", "Band Size: S[", "Age: S[", "Magnification Strength: S[")	
	for each balise in balises
		arg = f.GetCellByPosition(0,i).String
		eclats = split(arg,";")
		for each eclat in eclats
			r = split(eclat,balise)
			if UBound(r) = 1 Then
				s = r(1)
				t = split(s,"]")
				u = t(0)
				if InStr(1, v, u, 1) = 0 Then
					v = v & u & ", "				
				end if
			end if
		next eclat
		a = Mid(Trim(v),1,len(v)-2)
		p = len(a)
		f.GetCellByPosition(cl,i).SetString(a) 'remplissage colonnes adjascentes à droite de la colonne D
		cl = cl+1		
		if p > 0 Then
			r1 = r1 & balise & a & "] ; "
			v = ""
		end if		
	next balise	
	r1 = Mid(Trim(r1),1,len(r1)-2)
	f.GetCellByPosition(3,i).SetString(r1) ' remplissage colonne D
	r1 = ""
next
End Sub

et le fichier pour tester :

[camted]

Ajout : (édit 22 h 50) Code amélioré (plus compact) et fichier remplacé depuis la publication de ce message

Une nouvelle mouture dans le fichier joint. J'ai détourné l'utilisation de la fonction DEFRAG(). Pour exécuter la macro, il faut utiliser le raccourci clavier Ctrl+Maj+D :

Code : Tout sélectionner

Option Explicit

Sub Main
Dim f As Object, c As Object, b As Object
Dim balises As Variant, eclats As Variant, r As Variant, t As Variant, ad As Variant
Dim balise As String, arg As String, eclat As String, s As String
Dim u As String, v As String, a As String, r1 As String
Dim z As Long, i As Long, cl As Long, p As long

f = Thiscomponent.CurrentController.ActiveSheet 'Feuille active
c = f.Columns.GetByName("A") 'Colonne A
ad = c.queryEmptyCells.RangeAddresses 'Tableau des stuctures CellRangeAddress des lignes vides de la colonne A
z = ad(Ubound(ad)).StartRow -1 'Numéro dernière ligne remplie colonne A

For i = 1 to z
	cl = 4 'index colonne E
	balises = Array("Color: S[", "Size: S[", "NO.: S[", "Cup: S[", "Band Size: S[", "Age: S[", "Magnification Strength: S[")	
	for each balise in balises
		arg = f.GetCellByPosition(0,i).String
		eclats = split(arg,";")
		for each eclat in eclats
			r = split(eclat,balise)
			if UBound(r) = 1 Then
				s = r(1)
				t = split(s,"]")
				u = t(0)
				if InStr(1, v, u, 1) = 0 Then
					v = v & u & ", "				
				end if
			end if
		next eclat
		a = Mid(Trim(v),1,len(v)-2)
		p = len(a)
		f.GetCellByPosition(cl,i).SetString(a) 'remplissage colonnes adjascentes à droite de la colonne D
		cl = cl+1		
		if p > 0 Then
			r1 = r1 & balise & a & "] ; "
			v = ""
		end if		
	next balise	
	r1 = Mid(Trim(r1),1,len(r1)-2)
	f.GetCellByPosition(3,i).SetString(r1) ' remplissage colonne D
	r1 = ""
next
End Sub

et le fichier pour tester :

Bonsoir et merci encore,

je vais tester tout ceci et revenir vers toi demain au plus tard

[camted]

Ajout : (édit 22 h 50) Code amélioré (plus compact) et fichier remplacé depuis la publication de ce message

Une nouvelle mouture dans le fichier joint. J'ai détourné l'utilisation de la fonction DEFRAG(). Pour exécuter la macro, il faut utiliser le raccourci clavier Ctrl+Maj+D :

Code : Tout sélectionner

Option Explicit

Sub Main
Dim f As Object, c As Object, b As Object
Dim balises As Variant, eclats As Variant, r As Variant, t As Variant, ad As Variant
Dim balise As String, arg As String, eclat As String, s As String
Dim u As String, v As String, a As String, r1 As String
Dim z As Long, i As Long, cl As Long, p As long

f = Thiscomponent.CurrentController.ActiveSheet 'Feuille active
c = f.Columns.GetByName("A") 'Colonne A
ad = c.queryEmptyCells.RangeAddresses 'Tableau des stuctures CellRangeAddress des lignes vides de la colonne A
z = ad(Ubound(ad)).StartRow -1 'Numéro dernière ligne remplie colonne A

For i = 1 to z
	cl = 4 'index colonne E
	balises = Array("Color: S[", "Size: S[", "NO.: S[", "Cup: S[", "Band Size: S[", "Age: S[", "Magnification Strength: S[")	
	for each balise in balises
		arg = f.GetCellByPosition(0,i).String
		eclats = split(arg,";")
		for each eclat in eclats
			r = split(eclat,balise)
			if UBound(r) = 1 Then
				s = r(1)
				t = split(s,"]")
				u = t(0)
				if InStr(1, v, u, 1) = 0 Then
					v = v & u & ", "				
				end if
			end if
		next eclat
		a = Mid(Trim(v),1,len(v)-2)
		p = len(a)
		f.GetCellByPosition(cl,i).SetString(a) 'remplissage colonnes adjascentes à droite de la colonne D
		cl = cl+1		
		if p > 0 Then
			r1 = r1 & balise & a & "] ; "
			v = ""
		end if		
	next balise	
	r1 = Mid(Trim(r1),1,len(r1)-2)
	f.GetCellByPosition(3,i).SetString(r1) ' remplissage colonne D
	r1 = ""
next
End Sub

et le fichier pour tester :

Bonsoir et merci encore,

je vais tester tout ceci et revenir vers toi demain au plus tard

Bonjour très cher et un bon gros merci, car ta macro marche du tonnerre. Au top!

[micmac]

Bonjour,

Balisage dans le titre du dernier message = incorrect.
Pour être visibles depuis la page d'accueil, la balise [Résolu] avec sa coche verte doivent être placées au début du titre du PREMIER MESSAGE.
Voyez Comment clore correctement un sujet lorsqu'il est résolu

[camted]

Ok,

merci