Excel - Объедините несколько столбцов в один столбец

У меня есть несколько списков, которые находятся в отдельных столбцах в Excel. То, что я должен сделать, объединить эти столбцы данных в один большой столбец. Я не забочусь, существуют ли дублирующиеся записи, однако я хочу, чтобы это пропустило строку 1 из каждого столбца.

Также что относительно того, если ROW1 имеет заголовки с января по декабрь и длину столбцов, отличаются и должно быть объединение в один большой столбец?

ROW1| 1   2   3    
ROW2| A   D   G    
ROW3| B   E   H    
ROW4| C   F   I

должен объединиться в

A    
B    
C    
D    
E    
F    
G    
H    
I

Первая строка каждого столбца должна быть пропущена.

10
задан Community 9 July 2018 в 18:41
поделиться

3 ответа

Function Concat(myRange As Range, Optional myDelimiter As String) As String 
  Dim r As Range 
  Application.Volatile 
  For Each r In myRange 
    If Len(r.Text) Then 
      Concat = Concat & IIf(Concat <> "", myDelimiter, "") & r.Text 
    End If 
  Next 
End Function
1
ответ дан 3 December 2019 в 15:05
поделиться

Попробуйте. Щелкните в любом месте диапазона данных и используйте этот макрос:

Sub CombineColumns()
Dim rng As Range
Dim iCol As Integer
Dim lastCell As Integer

Set rng = ActiveCell.CurrentRegion
lastCell = rng.Columns(1).Rows.Count + 1

For iCol = 2 To rng.Columns.Count
    Range(Cells(1, iCol), Cells(rng.Columns(iCol).Rows.Count, iCol)).Cut
    ActiveSheet.Paste Destination:=Cells(lastCell, 1)
    lastCell = lastCell + rng.Columns(iCol).Rows.Count
Next iCol
End Sub
17
ответ дан 3 December 2019 в 15:05
поделиться

Не уверен, что это полностью помогает, но у меня была проблема, когда мне требовалось «умное» слияние. У меня было два столбца, A и B. Я хотел переместить B, только если A было пустым. См. ниже. Он основан на диапазоне выбора, который, возможно, можно использовать для смещения первой строки.

Private Sub MergeProjectNameColumns()
    Dim rngRowCount As Integer
    Dim i As Integer

    'Loop through column C and simply copy the text over to B if it is not blank
    rngRowCount = Range(dataRange).Rows.Count
    ActiveCell.Offset(0, 0).Select
    ActiveCell.Offset(0, 2).Select
    For i = 1 To rngRowCount
        If (Len(RTrim(ActiveCell.Value)) > 0) Then
            Dim currentValue As String
            currentValue = ActiveCell.Value
            ActiveCell.Offset(0, -1) = currentValue
        End If
        ActiveCell.Offset(1, 0).Select
    Next i

    'Now delete the unused column
    Columns("C").Select

    selection.Delete Shift:=xlToLeft
End Sub
1
ответ дан 3 December 2019 в 15:05
поделиться
Другие вопросы по тегам:

Похожие вопросы: