Astuces Excel
  1. Astuces Excel
  3. Comment puis-je split une cellule par return de voiture et append des valeurs?
Intereting Posts
PivotTable FormatConditions ScopeType provoque 1004 excel vba Ado distinct count avec Select statment using split fields Les valeurs d'appariement de la list vba et les valeurs de sous-concordance? excel macro pour modifier les connections de requêtes de données externes Est-il possible de verrouiller des cellules dans un excel par user partagé en utilisant une macro? Ressortingction du text à entrer dans une cellule avec Formule personnalisée (Validation de données) Première cellule vide Onglet Excel entre les controls NOT Keydown> Activer (feuille de calcul) Sélectionnez / Modifier / Entrer des blocs (verticalement) du text dans MS Word / Excel Array Median Si l'instruction ne fonctionne pas Formule Excel pour utiliser les nombres et le premier espace en tant que délimiteur Batch sauvegarde des images à partir de plusieurs files Excel dans un dossier Combinaison de données de plusieurs classurs en un maître Excel – Format d'label personnalisé pour transformer "1999Q4" en "1999" imprimer des données dans le même classur – java poi

Comment puis-je split une cellule par return de voiture et append des valeurs?

J'essaie de split une cellule par Carriage Return (3 cellules à gauche de ma cellule actuelle) et concaténer 'AND' pour tous les Retours de chariot, sauf le dernier, et pour le dernier je veux concatérer 'OUI'

Voici mon script VBA. 

CellSelect = ActiveCell.Value CellAddress = ActiveCell.Address Dim splitVals As Variant arrLines = Split(Sheets("CP (POS) Tasklist").Range(CellAddress).Offset(0, -3).Value, Chr(10)) For Each strLine In arrLines Debug.Print strLine Sheets("CP (POS) Tasklist").Range(CellAddress).Offset(0, 0).Value = strLine & Sheets("CP (POS) Tasklist").Range(CellAddress).Offset(0, -2).Value Next End If

Voici une capture d'écran de mon installation. Essentiellement, j'essaie de concatiner ce qui se trouve dans la 1ère, 2ème et 3ème cellules, dans la 4ème cellule.

entrez la description de l'image ici

Je pense que je suis proche. Je ne peux pas sembler le faire fonctionner correctement.

Merci!!

Il suffit de Replace par StrReverse qui fonctionnera. Aucun For ou Array requirejs. 

 Sub test() Dim strOrig As Ssortingng Dim strNew As Ssortingng 'strOrig = Sheet1.Cells(1) strOrig = "a " & Chr(10) & " b " & Chr(10) & " c " & Chr(10) Debug.Print strOrig ' a ' b ' c strNew = StrReverse(Replace(StrReverse(strOrig), Chr(10), StrReverse("YES"), , 1)) strNew = Replace(strNew, Chr(10), "AND") Debug.Print strNew 'a AND b AND c YES End Sub

Je l'ai travaillé avec ça. 

 CellSelect = ActiveCell.Value CellAddress = ActiveCell.Address Dim splitVals As Variant arrLines = Split(Sheets("CP (POS) Tasklist").Range(CellAddress).Offset(0, -3).Value, Chr(10)) arrLinesLast = UBound(arrLines) For Each strLine In arrLines If arrLinesLast <> 1 Then If arrLinesLast = 0 Then Exit Sub Debug.Print strLine Sheets("CP (POS) Tasklist").Range(CellAddress).Offset(0, 0).Value = Sheets("CP (POS) Tasklist").Range(CellAddress).Offset(0, 0).Value & " " & strLine & " " & Sheets("CP (POS) Tasklist").Range(CellAddress).Offset(0, -2).Value & Chr(10) arrLinesLast = arrLinesLast - 1 Else Sheets("CP (POS) Tasklist").Range(CellAddress).Offset(0, 0).Value = Sheets("CP (POS) Tasklist").Range(CellAddress).Offset(0, 0).Value & " " & strLine & " " & Sheets("CP (POS) Tasklist").Range(CellAddress).Offset(0, -1).Value arrLinesLast = arrLinesLast - 1 End If Next

Vous pouvez essayer cela: divisez la valeur de la cellule vers un tableau, puis ajoutez AND ou YES si c'est le dernier élément du tableau: 

 Option Explicit Sub Test() Dim rng As Range Set rng = Sheet1.Range("A1") AppendAndYes rng End Sub Sub AppendAndYes(rngCell As Range) Dim varItems As Variant Dim lngIndex As Long 'get lines by splitting on line feed varItems = Split(rngCell.Value, vbLf, -1, vbBinaryCompare) 'loop through and add AND or YES For lngIndex = LBound(varItems) To UBound(varItems) If lngIndex < UBound(varItems) Then varItems(lngIndex) = varItems(lngIndex) & " AND" Else varItems(lngIndex) = varItems(lngIndex) & " YES" End If Next lngIndex 'update cell value rngCell.Value = Join(varItems, vbLf) End Sub