У меня есть несколько списков, которые находятся в отдельных столбцах в 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
Первая строка каждого столбца должна быть пропущена.
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
Попробуйте. Щелкните в любом месте диапазона данных и используйте этот макрос:
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
Не уверен, что это полностью помогает, но у меня была проблема, когда мне требовалось «умное» слияние. У меня было два столбца, 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