如何拆分一个单元格通过回车和追加值？

我试图通过回车（我的当前单元格左边的3个单元格）拆分一个单元格，并将所有回车返回（除最后一个之外）的“AND”连接起来，对于最后一个，我想连接“YES”

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

这里是我的设置的屏幕截图。 基本上，我试图将第一，第二和第三个单元格中的内容连接到第四个单元格。

我想我很接近。 我似乎无法让它正常工作。

谢谢！！

Answer 1

只需Replace StrReverse Replace就可以工作。 不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