Split cellule multiligne

Bonjour à tous,

Cherchant à extraire le contenu de cellules multiligne selon une colonne comportant plusieurs critères par cellule, je bloque sur la récupération d'une colonne. l'utilisation de la fonction split en colonne A est Ok, mais pas sur B. J'ai essayé de changé l'indice k dans la boucle par k-1 mais ça génère une erreur.

Si quelqu'un voit la solution.

pWS.Cells(pRow, 2) = Left(Numdoc(j), k)    ' n°doc colonne B

bonjour,

quel est le but de cette instruction ?

k = InStr(Numdoc(j), " ")

pour moi elle est inutile (pas de blanc dans cette colonne). Si elle est utile, alors il faut tester sa valeur pour une execution correcte de l'instruction suivante.

pWS.Cells(pRow, 2) = Left(Numdoc(j), k)

Ci dessous correction en supprimant ces instructions inutiles.

Sub Extraction()

Dim oWS As Worksheet, pWS As Worksheet
Dim oRow As Long, pRow As Long
Dim splitMultiLine As String, splitPerfix As String
Dim c As Long, i As Long, j As Long, k As Long
Dim Critère As Variant, Numdoc As Variant
Dim dataACol As String, dataBCol As String, dataCCol As String

Set oWS = Worksheets("Matrice")
Set pWS = Worksheets("Extraction")

'ligne titre
For c = 1 To 3
  pWS.Cells(1, c) = oWS.Cells(1, c)
Next c

oRow = 2 ' ligne de oWS
pRow = 2 ' ligne de pWS

With oWS
  While (.Cells(oRow, 1) <> "")

    dataACol = .Cells(oRow, 1)
    dataBCol = .Cells(oRow, 2)
    dataCCol = .Cells(oRow, 3)

    Critère = Split(dataACol, ",")
    Numdoc = Split(dataBCol, Chr(10))        ' split (Char(10))

    For i = LBound(Critère) To UBound(Critère)
      For j = LBound(Numdoc) To UBound(Numdoc)

        pWS.Cells(pRow, 1) = Trim(Critère(i))      ' critère colonne A

        'k = InStr(Numdoc(j), " ")

        'pWS.Cells(pRow, 2) = Left(Numdoc(j), k)    ' n°doc colonne B
        pWS.Cells(pRow, 2) = Numdoc(j)   ' n°doc colonne B
        pWS.Cells(pRow, 3) = dataCCol              ' exigence conne C
        pRow = pRow + 1
      Next j
    Next i

    oRow = oRow + 1
  Wend
End With
End Sub

Bonjour

Bonjour à tous

Une variante.

Bye !

Bonjour H2SO4,

Ta question m'a amené à comprendre pourquoi cette ligne dans le code initialement concernant les espaces.

en insérant des nombres avec un espace avant de passer en multiligne le code ci-dessous fonctionne. J'e fais l'hypothèse que les nombres récupérés dans la colonne N°doc pouvaient avoir des espaces "non perceptibles à l'oeil" en fonction de la source des données d'origine.

k = InStr(Numdoc(j), " ")

        pWS.Cells(pRow, 2) = Left(Numdoc(j), k - 1) ' n°doc colonne B

Merci d'avoir porté ton regard utile dessus.

Bonjour gmb,

Quel code compact, je vais l'étudier avec intérêt.

Merci,

Bonjour à tous,

en utilisant le code de gmb avec des cellules (Exigences) de plus de 255 caractères, une erreur de produit sur la partie de code

Resize(UBound(tabloR, 2),3)= Application.Transpose(tabloR)

S'agit-il d'une limitation d'Excel 2010, et comment la contourner ?

merci d'avance

Bonjour à tous

S'agit-il d'une limitation d'Excel 2010,

On a souvent de mauvaises surprises quand on met plus de 225 caractères dans une cellule.

et comment la contourner ?

Aucune idée sinon mettre moins de carctères dans les cellules !

Bye !

bonjour,

255 caractères est une limitation de l'instruction transpose. Pour s'affranchir de cette instruction, une proposition d'adaptation du code de gmb (que je salue)

Option Explicit

Dim fM As Worksheet, fE As Worksheet, tablo, tabloR(1 To 100000, 1 To 3)  '<- adapter 100000 au nombre max de lignes qui seront générées
Dim i&, nbLnA&, nbLnB&, col&, k&
Dim nA&, nB&

Sub Extraire()

    Set fM = Sheets("Matrice")
    Set fE = Sheets("Extraction")
    tablo = fM.Range("A1").CurrentRegion
    k = 0
    For i = 2 To UBound(tablo, 1)
        nbLnA = UBound(Split(tablo(i, 1), ","))  ' nbre de critère par cellulue de la colonne A
        nbLnB = UBound(Split(tablo(i, 2), Chr(10))) + 1
        For nA = 0 To nbLnA
            For nB = 0 To nbLnB - 1
                tabloR(k + 1, 1) = Split(tablo(i, 1), ",")(nA)
                tabloR(k + 1, 2) = Split(tablo(i, 2), Chr(10))(nB)
                tabloR(k + 1, 3) = tablo(i, 3)
                k = k + 1
            Next nB
        Next nA

    Next i
    fE.Range("A2").CurrentRegion.Offset(1, 0).ClearContents
    fE.Range("A2").Resize(k, 3) = tabloR
    fE.Activate
End Sub

Bonjour à tous,

Merci à H2SO4 pour l'adaptation du code de gmb. Je prends bonne note des 255 caractères.

A présent, les 2 codes différents de gmb et H2SO4 permettent d'extraire le fichier source, c'est au choix.

Merci à tous les deux

@ h2so4 : Merci, j'ai appris quelque chose.

Bye !