Excel：VBA 脚本将文本连接到下一个以数字开头的单元格？

Question

在 Excel 中，我的数据如 A 列和 B 列所示。

我想自动填充 C 列中显示的数据。

A	B	C - 期望的结果
2024 年 2 月 1 日	文字1	文字1
2024 年 2 月 1 日	文字2	文字 2、文字 3、文字 4、文字 5、文字 6
文字3
文字4	文字5
文字6
2024 年 2 月 1 日	文字7	文字7
2024 年 2 月 1 日	文字8	文字8

我真的很难编写一个 VBA 脚本来做到这一点。请问有人可以帮忙吗？

我尝试了以下脚本：

Sub ConcatenateUntilNumber()

    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim result As String
    
 
    Set ws = ThisWorkbook.Sheets("Sheet3")
    
    
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    
    result = ""
    
    
    For i = 1 To lastRow
    
        If ws.Cells(i, 1).Value <> "" Then
        
            If IsNumeric(Left(ws.Cells(i, 1).Value, 1)) Then
            
                If result <> "" Then
                    ws.Cells(i, 3).Value = result 
                End If
                result = "" 
            Else
                
                If result = "" Then
                    result = ws.Cells(i, 1).Value & " " & ws.Cells(i, 2).Value
                Else
                    result = result & ", " & ws.Cells(i, 1).Value & " " & ws.Cells(i, 2).Value
                End If
            End If
        End If
    Next i
    
End Sub

但这就是唯一的结果：

A	B	C - 结果
2024 年 2 月 1 日	文字1
2024 年 2 月 1 日	文字2
文字3
文字4	文字5
文字6
2024 年 2 月 1 日	文字7	文本 3、文本 4 文本 5、文本 6
2024 年 2 月 1 日	文字8

Answer 1

如果您有权访问

MS365

那么也许您也可以使用以下公式完成所需的输出：

---

• 单元格中使用的公式 C2

=LET(
     a, A2:B8,
     b, TAKE(a,,1),
     c, ISERR(--b),
     d, SCAN(0,1-c,LAMBDA(x,y,IF(y,x+1,x))),
     e, IF(1-c,MAP(d,LAMBDA(z, TEXTJOIN(", ",1,IF(ISERR(--a)*(z=d),a,"")))),""),
     e)

---

Answer 2

试试这个：

Sub Compile()
    Dim ws As Worksheet, lr As Long
    Dim c As Range, cDest As Range, sep As String, v
    
    Set ws = ThisWorkbook.Sheets("Sheet9")
    'last row in A or B
    lr = Application.Max(ws.Cells(Rows.Count, "A").End(xlUp).Row, _
                         ws.Cells(Rows.Count, "B").End(xlUp).Row)
    Debug.Print lr
    For Each c In ws.Range("A1:B" & lr).Cells
        'date in col A ?
        If c.Column = 1 And c.Value Like "##/???/####" Then
            Set cDest = c.Offset(0, 2) 'set the destination cell
            sep = ""                   'reset the separator
        Else
            v = c.Value
            If Len(v) > 0 And Not cDest Is Nothing Then
                cDest.Value = cDest.Value & sep & v
                sep = ", " 'populate the separator after first value
            End If
        End If
    Next c
End Sub