Excel宏多范围串联

时间:2015-01-23 20:27:58

标签: excel vba excel-vba

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

Degree1
 Course1,Course2,Course3
 课程4,课程5,课程6

Degree2
 Course1,Course2
 Course3,Course4
 Course5
 课程6,课程7

Degree3
 Course1,Course2,Course3
 Course4,course5,course6
 课程7

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

我正在使用excel查找功能来识别包含度和度的单元格。选择它下面的课程。我也在使用http://www.contextures.com/rickrothsteinexcelvbatext.html中的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

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

1 个答案:

答案 0 :(得分: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可能已经足够了,但这可能有助于理解目的各种代码行。

Concatenate degrees