キャリッジリターンと値の追加によってセルを分割するにはどうすればよいですか？

Question

私はキャリッジリターン（現在のセルの左側に3セル）でセルを分割しようとしていて、最後のものを除くすべてのキャリッジリターンと '連結'するために 'AND'を連結します。 '

ここに私の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 

ここに私のセットアップのスクリーンショットがあります。基本的には、1番目、2番目、3番目のセルを4番目のセルに連結しようとしています。

私は近いと思います。私はちょうどそれが正しく働くように見えることができません。

ありがとうございます！

Answer 1

私はこれを使って作業しました。

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 

Answer 2

あなたはこれを試すことができます。配列にセルの値を分割し、それは、配列内の最後の項目であるならば、YES追加したり：

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 

Answer 3

だけReplaceStrReverseとworkfineます。いいえForまたはArrayが必要です。

Sub test() 

    Dim strOrig As String 
    Dim strNew As String 


    '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