Excelmacros多重连接

我试图通过Excel VBA连接单元格。 这涉及多个范围。 下面是我的桌子

Degree1
Course1，Course2，Course3
Course4，course5，course6

Degree2
Course1，Course2
Course3，Course4
Course5
Course6，Course7

Degree3
Course1，Course2，Course3
Course4，course5，course6
Course7

我想把学位下面列出的所有课程连接到学位旁边的单个单元格。 每个学位都有多个课程，每个学位的行数都不相同。

我正在使用excel查找function来识别单元格包含的程度，并select它下面的课程。 我也使用从http://www.contextures.com/rickrothsteinexcelvbatext.html concat函数，以便我可以连接选定的范围。

我试图写下面的代码，但这是行不通的，最后我得到了值错误。 我想范围不存储在variables中

 Sub concatrange() Dim D1Crng As Range 'to set courses under degree1 as range Dim D2Crng As Range Dim D3Crng As Range Dim D1cell As Range 'to identify the cell of D1 and set it as range Dim D2cell As Range Dim D3cell As Range Range("A1:B100").Select Selection.Find(What:="Degree1", _ LookIn:=xlValues, LookAt:=xlPart, _ SearchOrder:=xlByColumns, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Select ActiveCell.Select Set D1cell = Selection Range(D1cell).Activate ActiveCell.Offset(1, 0).End(xlDown).Select Set D1Crng = Selection Range(D1cell).Activate ActiveCell.Offset(0, 1).Select Selection.Formula = "=concat("","",D1Crng)" End sub 

我正在重复上述过程来连接其他学位。

Answer 1

VBA的.Join命令应该在这里工作。

 Sub many_degrees() Dim rw As Long With ActiveSheet For rw = 1 To .Cells(Rows.Count, 1).End(xlUp).Row If LCase(Left(.Cells(rw, 1).Value, 6)) = "degree" Then If Application.CountA(.Cells(rw, 1).Resize(3, 1)) > 2 Then .Cells(rw, 2) = Join(Application.Transpose(.Range(.Cells(rw, 1).Offset(1, 0), .Cells(rw, 1).End(xlDown)).Value), Chr(44)) Else .Cells(rw, 2) = .Cells(rw, 1).Offset(1, 0).Value End If End If Next rw End With End Sub 

我已经说明了DegreesX标题下面只有一个（或没有）度数的情况 。 代码确实依赖于以Degree开头的每个“标题”作为前6个字符（不区分大小写）。 我使用了.Offset(x, y) ，其中行或列的简单+1可能已经足够了，但这可能有助于理解各种代码行的用途。