excel - 单元格范围到带有回车的单个单元格

Question

我正在阅读我的第一本 VBA 书籍，如果有人能指出我正确的方向，我将不胜感激。如何将一系列行传输到带有回车的单个单元格中？然后，我想对列中的所有范围重复此操作。

我想我需要：

• 在列中找到第一个具有值的单元格
• 验证下一行不为空
• 找到范围内的最后一个单元格
• 在范围上执行“操作”

Answer 1

跟进我的评论。这是实现您想要的非常简单的方法。

Option Explicit

'~~> You can use any delimiter that you want
Const Delim = vbNewLine

Sub Sample()
    Dim rngInput As Range, rngOutput As Range

    Application.ScreenUpdating = False

    Set rngInput = Range("A1:A5") '<~~ Input Range
    Set rngOutput = Range("B1")   '<~~ Output Range

    Concatenate rngInput, rngOutput

    Application.ScreenUpdating = True
End Sub

Sub Concatenate(rng1 As Range, rng2 As Range)
    Dim cl As Range
    Dim strOutPut As String

    For Each cl In rng1
        If strOutPut = "" Then
            strOutPut = cl.Value
        Else
            strOutPut = strOutPut & Delim & cl.Value
        End If
    Next

    rng2.Value = strOutPut
End Sub

Answer 2

在工作表级代码的上下文中，以下将起作用。第 2 列是硬编码的，因此您可能需要传入一个值或以其他方式对其进行修改以满足您的需要。

Dim rng As Range
Set rng = Me.Columns(2)

Dim row As Integer
row = 1

' Find first row with non-empty cell; bail out if first 100 rows empty
If IsEmpty(Me.Cells(1, 2)) Then
    Do
        row = row + 1
    Loop Until IsEmpty(Me.Cells(row, 2)) = False Or row = 101
End If

If row = 101 Then Exit Sub

' We'll need to know the top row of the range later, so hold the value
Dim firstRow As Integer
firstRow = row

' Combine the text from each subsequent row until an empty cell is encountered
Dim result As String
Do
    If result <> "" Then result = result & vbNewLine
    result = result & Me.Cells(row, 2).Text
    row = row + 1
Loop Until IsEmpty(Me.Cells(row, 2))

' Clear the content of the range
Set rng = Me.Range(Me.Cells(firstRow, 2), Me.Cells(row, 2))
rng.Clear

' Set the text in the first cell
Me.Cells(firstRow, 2).Value2 = result