Simplification de formule

[Victor21]

Bonjour à tous.
Je désire concaténer toutes les valeurs de la colonne D, de 9 lignes en 9 lignes, répondant à une condition.
Y a-t-il plus simple que :
SI(NBCAR(AH4)>3;"ERREUR";SI(E3=Nom;D3;"")&SI(E12=Nom;D12;"")&SI(E21=Nom;D21;"")&SI(E30=Nom;D30;"")&SI(E39=Nom;D39;"")&SI(E48=Nom;D48;"")&SI(E57=Nom;D57;"")&SI(E66=Nom;D66;"")&SI(E75=Nom;D75;"")&SI(E84=Nom;D84;"")&SI(E93=Nom;D93;"")&SI(E102=Nom;D102;"")&SI(E111=Nom;D111;"")&SI(E120=Nom;D120;"")&SI(E129=Nom;D129;"")&SI(E138=Nom;D138;"")&SI(E147=Nom;D147;"")&SI(E156=Nom;D156;"")&SI(E165=Nom;D165;"")&SI(E174=Nom;D174;"")&SI(E183=Nom;D183;"")&SI(E192=Nom;D192;"")&SI(E201=Nom;D201;""))
La colonne D contient des valeurs alpha.

D'avance, merci

Commentaire :
En cas d'impossibilité, ce qui semble le cas selon les opinions trouvées sur le web,une fonction perso ou une macro me conviendrait bien évidemment !
Le résultat est appelé à être recopié sur 9 cellules verticales.

 

[sousou]

Re : Simplification de formule

Bonjour Victor21
Une petite fonction qui concatene les valeurs suivant un pas régulier
=modulo(zone,v)
zone est la zone ou elle s'applique, v est le pas dans ton cas 9

Function modulo(zone, v)
n = Int(zone.Rows.Count / v)
For i = 0 To n
MsgBox zone.Row
k1 = zone.Cells((v * i) + 1, 1)
c = c & k1
Next
modulo = c
End Function

 

[Victor21]

Re : Simplification de formule

Bonjour, sousou.

Cette fonction concaténe bien, mais ne tient pas compte du test si(e3=nom... si E12 = nom...).

Il me semble possible d'imbriquer le test sur le même principe. Je m' y mets et vous tiens informé si j'aboutis.

En tous cas, merci beaucoup..

 

[kjin]

Re : Simplification de formule

Bonsoir,
Fonction perso...

Function CONCAT(Rng As Range, C As Byte, S As Byte, V As Variant) As String
With Rng
    For i = 1 To .Rows.Count Step S
        If .Cells(i, C) = V Then
            CONCAT = CONCAT & .Cells(i, 1)
        End If
    Next
End With
End Function

...et dans la cellule

=SI(NBCAR(AH4)>3;"ERREUR";CONCAT(D3:E351;2;9;Nom))

A+
kjin

 

[Victor21]

Re : Simplification de formule

Bonjour, kjin.

Merci pour votre aide.

Quelques précisions :

SI(NBCAR(AH4)>3;"ERREUR";SI(E3=Nom;D3;"")&SI(E12=Nom;D12;"")&...&SI(E201=Nom;D201;""))
Nom est une zone fixe ($AH$1)
E$3:E$209 est une colonne contenant le nom des profs
D$3: D$209 est une colonne contenant des matières (ex maths, anglais...)

Je souhaite afficher dans ma cellule la matière figurant en col D si le prof en col E correspond au nom du prof en AH1

Cordialement,

 

[Tibo]

Re : Simplification de formule

Bonjour,

Avec le fichier (ou un extrait) qui va avec la formule, ce serait mieux pour pouvoir t'aider.

@+

 

[kjin]

Re : Simplification de formule

bonsoir, salut Tibo 🙂,
Comprends pas, c'est bien ce que fait la fonction

CONCAT(plage de recherche;colonne de recherche dans la plage;saut de ligne;Nom)

Juste une modif pour respecter la casse et ajout d'un tiret si plusieurs valeurs
A+
kjin

 

[Victor21]

Résolu : Simplification de formule

Bonsoir, kjin, sousou, tibo.

Votre fonction fonctionne parfaitement.
C'est moi qui ai mal décrit mon environnement, et tibo a raison : avec un fichier, c'est plus clair.

Le fichier, réduit à sa plus simple expression, faisant 74 Ko, je ne peux donc le joindre.

Son adresse sur cjoint :
http://cjoint.com/?0bywUQDWENj

Je vous adresse cependant la macro d'un autre internaute qui résout mon problème.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range) 'GuyXL, Développer.net

Dim oWsHC As Worksheet 'feuille Horaire Classe
Dim oWsHN As Worksheet 'feuille Horaire Nom
Dim vSNom As String 'la condition
Dim vLDLg As Long 'la dernière ligne du tableau Horaire Classe
Dim vbLEc As Byte 'ligne d'écriture
Dim i As Byte
Dim j As Long

If Target.Address = "$AH$1" And Target.Count = 1 Then 'si l'on change la valeur de Nom

vSNom = Cells(1, 34) 'initialisation du nom

'dernière ligne tableau
vLDLg = Cells(Rows.Count, 1).End(xlUp).Row
If (vLDLg - 2) Mod 9 <> 0 Then 'contrôle : ce tableau doit contenir un multiple de 9 lignes
MsgBox "Anomalie nombre de ligne tableau Matière-Prof"
Exit Sub
End If

'objets
Set oWsHC = ActiveSheet
Set oWsHN = Worksheets("Horaire Nom")

'nettoyage feuille Horaire Nom
oWsHN.Range("B3:C11, E3:F11, H3:I11, B15:C23, E15:F23, H15:I23").ClearContents
'oWsHN.Range("B3:B11, E3:E11, H3:H11, B15:B23, E15:E23, H15:H23").Interior.ColorIndex = 4
'oWsHN.Range("C3:C11, F3:F11, I3:I11, C15:C23, F15:F23, I15:I23").Interior.ColorIndex = 5

'traitement
For i = 5 To 20 Step 3 'pour chaque jour
For j = 3 To vLDLg 'pour chaque ligne
If Cells(j, i) = vSNom Then

'calcul de la ligne d'écriture
Select Case i
Case 5, 8, 11
vbLEc = j - 9 * Int((j - 3) / 9)
Case 14, 17, 20
vbLEc = j - 9 * Int((j - 3) / 9) + 12
End Select


Select Case i
Case 5, 8, 11
'classes
If oWsHN.Cells(vbLEc, i - 3) = "" Then
oWsHN.Cells(vbLEc, i - 3) = Cells(j, 2) '1ère occurence
Else
oWsHN.Cells(vbLEc, i - 3) = oWsHN.Cells(vbLEc, i - 3) & "," & Cells(j, 2) 'occurences suivantes
'oWsHN.Cells(vbLEc, i - 3).Interior.ColorIndex = 3 'coloriage alerte plusieurs classes
End If

'matières
If oWsHN.Cells(vbLEc, i - 2) = "" Then
oWsHN.Cells(vbLEc, i - 2) = Cells(j, i - 1) '1ère occurence
Else
'occurences suivantes, contrôle matières différentes pour même horaire
If oWsHN.Cells(vbLEc, i - 2) <> Cells(j, i - 1) Then
oWsHN.Cells(vbLEc, i - 2) = "Anomalie"
'oWsHN.Cells(vbLEc, i - 2).Interior.ColorIndex = 3
End If
End If
Case 14, 17, 20
'classes
If oWsHN.Cells(vbLEc, i - 12) = "" Then
oWsHN.Cells(vbLEc, i - 12) = Cells(j, 2) '1ère occurence
Else
oWsHN.Cells(vbLEc, i - 12) = oWsHN.Cells(vbLEc, i - 12) & "," & Cells(j, 2) 'occurences suivantes
'oWsHN.Cells(vbLEc, i - 12).Interior.ColorIndex = 3 'coloriage alerte plusieurs classes
End If

'matières
If oWsHN.Cells(vbLEc, i - 11) = "" Then
oWsHN.Cells(vbLEc, i - 11) = Cells(j, i - 1) '1ère occurence
Else
'occurences suivantes, contrôle matières différentes pour même horaire
If oWsHN.Cells(vbLEc, i - 11) <> Cells(j, i - 1) Then
oWsHN.Cells(vbLEc, i - 11) = "Anomalie"
'oWsHN.Cells(vbLEc, i - 11).Interior.ColorIndex = 3
End If
End If
End Select

End If
Next j
Next i
End If

'oWsHN.Activate
Set oWsHN = Nothing
Set oWsHC = Nothing

End Sub
Je vous remercie sincèrement, ainsi que les autres membres de ce forum, pour l'aide apportée.

Bien cordialement,