utiliser join avec un certain type de cellules

supercrapaud

XLDnaute Occasionnel
Bonjour à vous tous si tard

Je planche sur cette question mais je n'ai pas trouvé sur Internet ma réponse. Est-il possible d'utiliser la fonction join avec un certain type de cellules ? Ou bien dois-je passer par la création d'un tableau directement trié pour ensuite faire que Join marche.

Pour être plus clair voici mon code mais qui ne marche pas (je souhaiterais qu'il concatène les données des cellules non vides d'un range) :

Join(Application.Transpose(Sheets("X").Range("a23:a76").SpecialCells(xlCellTypeConstants, 23).Value), ";")

Pour info ce code m'a été conseillé sur ce site. Je n'ai pas mis de fichier car il me semble que le code se suffit mais bon...

Donc à vos avis et comme d'habitude merci à vous.
 

Dranreb

XLDnaute Barbatruc
Re : utiliser join avec un certain type de cellules

Bonjour.
À mon avis vous devez empiler dans un tableau en bouclant sur les Area. Un peu comme je l'ai fait pour récupérer une plage filtrée, laquelle détermine aussi une plage multizone.
VB:
Function ValeursFiltrée(Optional ByVal F As Worksheet) As Variant()
If F Is Nothing Then Set F = ActiveSheet
ValoriserFiltre ValeursFiltrées(F)
End Function
Sub ValoriserFiltre(TSorti() As Variant, ByVal F As Worksheet)
Dim PlgF As Range, LMax As Long, CMax As Long, Zone As Range, TEntré() As Variant, L As Long, C As Long
Set PlgF = F.AutoFilter.Range
Set PlgF = PlgF.Rows(2).Resize(PlgF.Rows.Count - 1)
Set PlgF = PlgF.SpecialCells(xlCellTypeVisible)
LMax = 0: CMax = PlgF.Columns.Count
For Each Zone In PlgF.Areas
   LMax = LMax + Zone.Rows.Count
   Next Zone
ReDim TSorti(1 To LMax, 1 To CMax) As Variant
LMax = 0
For Each Zone In PlgF.Areas
   TEntré = Zone.Value
   For L = 1 To UBound(TEntré, 1): LMax = LMax + 1
      For C = 1 To CMax: TSorti(LMax, C) = TEntré(L, C): Next C
      Next L
   Next Zone
End Sub
À +
 

ROGER2327

XLDnaute Barbatruc
Re : utiliser join avec un certain type de cellules

Bonjour à tous


La "méthode" SpecialCells est un truc des plus merdiques dont le Bill's Band a le secret et qui fait le charme de notre tableur préféré. C'est pour cela qu'on l'aime.

Par exemple, Range.SpecialCells(xlCellTypeConstants) peut, contre toute attente, renvoyer une plage plus large que Range ! J'en passe, et des meilleurs...

Bref, il convient d'être prudent.

En pièce jointe, une tentative de contrôle de la chose avec cette fonction :​
VB:
Function tutu(Plage As Range, Optional typ As XlSpecialCellsValue = xlLogical + xlNumbers)
'
'¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯'
'  4 Fructidor CCXX (escourgeon)   ROGER2327 fecit.  '
'____________________________________________________'
'
Dim kc%, k1%, k2%, tf As Boolean, vc(), v1(), v2(), Colonne As Range, Plage1 As Range, Plage2 As Range, Col As Range
    With Plage
'
'=== Facultatif : ===
'        On Error Resume Next
'        Set Col = .SpecialCells(xlCellTypeConstants, typ)
'        On Error GoTo 0
'        If Col Is Nothing Then Beep Else Col.Select
'====================
'
        ReDim v1(1 To .Areas.Count)
        For Each Plage1 In .Areas
            tf = False
            ReDim vc(1 To Plage1.Columns.Count)
            kc = 0
            For Each Colonne In Plage1.Columns
                On Error Resume Next
                Set Col = Intersect(Colonne, Colonne.SpecialCells(xlCellTypeConstants, typ))
                On Error GoTo 0
                If Col Is Nothing Then
                    If UBound(vc) > 1 Then ReDim Preserve vc(1 To UBound(vc) - 1)
                Else
                    kc = kc + 1
                    tf = True
                    If Col.Count = 1 Then
                        vc(kc) = Col.Value
                    Else
                        ReDim v2(1 To Col.Areas.Count)
                        k2 = 0
                        For Each Plage2 In Col.Areas
                            k2 = k2 + 1
                            If Plage2.Count = 1 Then
                                v2(k2) = Plage2.Value
                            Else
                                v2(k2) = Join(WorksheetFunction.Transpose(Plage2.SpecialCells(xlCellTypeConstants, typ).Value), ";")
                            End If
                        Next
                        vc(kc) = Join(v2, ";")
                    End If
                    Set Col = Nothing
                End If
            Next
            If tf Then k1 = k1 + 1: v1(k1) = Join(vc, ";") Else If UBound(v1) > 1 Then ReDim Preserve v1(1 To UBound(v1) - 1)
        Next
    End With
    tutu = Join(v1, ";")
End Function
Enjoy!, comme on ne dit pas chez nous.​



ROGER2327
#6267


Mercredi 11 Phalle 139 (Sainte Lèchefrite, botteuse - fête Suprême Quarte)
4 Fructidor An CCXX, 4,0159h - escourgeon
2012-W34-2T09:38:18Z
 

Pièces jointes

  • XLD_190617_Cellules_particulières.xlsm
    23.7 KB · Affichages: 31
  • XLD_190617_Cellules_particulières.xlsm
    23.7 KB · Affichages: 32
  • XLD_190617_Cellules_particulières.xlsm
    23.7 KB · Affichages: 32

pierrejean

XLDnaute Barbatruc
Re : utiliser join avec un certain type de cellules

Bonjour à tous

J'ose esperer que ROGER :rolleyes: me pardonnera de squatter honteusement son fichier et de profiter ainsi de sa formidable aptitude à generer des jeux d'essai

Un essai sans join
 

Pièces jointes

  • XLD_190617_Cellules_particulières.xlsm
    25.4 KB · Affichages: 41
  • XLD_190617_Cellules_particulières.xlsm
    25.4 KB · Affichages: 42
  • XLD_190617_Cellules_particulières.xlsm
    25.4 KB · Affichages: 44

Dranreb

XLDnaute Barbatruc
Re : utiliser join avec un certain type de cellules

Bonjour tous.
Ah, il est fort probable que la fonction Toto marche.
Mais comme:
1) - je ne sais jamais ce qui marche et ce qui ne marche pas avec les plages multizone (le fait qu'il y en a qui ne marchent pas me suffit),
2) - j'aime autant retrouver dans le code de quoi me rappeler qu'il est conçu pour traiter de telles plages,
je l'aurais personnellement écrit comme ça (avec concession sur d'indentation qui n'est pas la mienne habituelle, mais pas sur la majuscule au début des noms de variables)
VB:
Function Toto(Plage As Range) As String
Dim Tot As String
Dim Zon As Range
Dim Cel As Range
On Error Resume Next
For Each Zon In Plage.Areas
    For Each Cel In Zon
       If Cel.Value <> "" Then
          Tot = Tot & Cel.Value & ";"
       End If
    End If
Next
On Error GoTo 0
If Tot <> "" Then Toto = Left(Tot, Len(Tot) - 1)
End Function
À +
 
Dernière édition:

pierrejean

XLDnaute Barbatruc
Re : utiliser join avec un certain type de cellules

Re

Salut Dranreb :p

Pour ma part je fais rarement de concession sur le test de mes macros
Je te propose une petite modification :

Code:
Function Toto(Plage As Range) As String
Dim Tot As String
Dim Zon As Range
Dim Cel As Range
On Error Resume Next
For Each Zon In Plage.Areas
    For Each Cel In Zon
       If Cel.Value <> "" Then
          Tot = Tot & Cel.Value & ";"
       End If
    Next
Next
On Error GoTo 0
If Tot <> "" Then Toto = Left(Tot, Len(Tot) - 1)
End Function
 

Dranreb

XLDnaute Barbatruc
Re : utiliser join avec un certain type de cellules

Ah, oui ! Tiens j'avais un End If au lieu d'un Next…
Comme quoi je ne suis pas familiarisé avec l'indentation classique (elle me fait croire que le Next y est, puisque je retourne d'un cran), et tu as donc raison … plus de concession ! :rolleyes:
Cordialement.
 

laetitia90

XLDnaute Barbatruc
Re : utiliser join avec un certain type de cellules

bonjour les amis:):):):):):):)
pour seulement repondre sur le code de supercrapaud
en l'adaptant comme cela devrait marcher???


Code:
[B1] = Replace(Application.WorksheetFunction.Trim(Join(Application.Transpose(Sheets("x").[A23:A76].Value), " ")), " ", ";")

ps : quoi que pas sur du tout repondu un peu hativement :(
 
Dernière édition:

supercrapaud

XLDnaute Occasionnel
Re : utiliser join avec un certain type de cellules

Bonjour à tout le fil.

Je vous remercie pour toutes vos réponses aussi complètes semblent-elles. Bref si je comprends bien, il faut que j'écrive toutes ces lignes pour pouvoir juste concaténer des données d'une range dans une cellules... Le problème c'est que je fais cela pour 4 ranges alors :p Mais bon peut-être qu'avec un peu de chance je vais réussir à bidouiller mon fichier pour pouvoir faire plus simple.

Mais si vous voyez autre chose n'hésitez pas. En tout cas merci encore.
 

Discussions similaires

Statistiques des forums

Discussions
312 492
Messages
2 088 936
Membres
103 985
dernier inscrit
JL Fargeas