Question

我试图通过Carriage Return（当前单元格左侧的3个单元格）拆分单元格并连接＆＃39; AND＆＃39;除了最后一个之外的所有回车，以及我要连接的最后一个回车＆＃39;是＆＃39;

这是我的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

只有Replace StrReverse才能正常工作。无需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

Answer 2

我得到了它。

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 3

您可以尝试这样做：将单元格值拆分为数组，然后添加AND或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

如何通过回车和附加值拆分单元格？

3 个答案: