Диапазон ячеек в одну ячейку с возвратом каретки

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