Vba Excel宏多范围串联

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

等级1 课程1，课程2，课程3 课程4，课程5，课程6

等级2 课程1，课程2 课程3，课程4 课程5 课程6，课程7

度3 课程1，课程2，课程3 课程4，课程5，课程6 课程7

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

我正在使用excel查找功能识别包含学位的单元格并选择其下方的课程。我还使用了中的concat函数，以便连接选定的范围

我试图写下面的代码，但这是不工作，我得到的值错误在最后。我猜范围没有存储在变量中

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

我重复上面的过程来连接其他学位

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标题下只有一行或没有一行学位的情况。代码取决于以度开头的每个“标题”，前6个字符不区分大小写。我使用了.Offsetx，y，其中行或列的简单+1可能就足够了，但这可能有助于理解各种代码行的用途

---

非常感谢！嘲笑。你的代码工作完美&节省了我很多时间。