Excel VBA：合并一个循环内的范围 [英] Excel VBA: Merging a range inside a loop

问题描述

$ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $

I want to merge that repeating Chapters into just one cell by Chapter.

这是我的代码循环的方式。

Here is how my code does the looping.

        Dim label As Control
        Dim itm As Object
        For ctr = 1 To InfoForm.Chapter.ListCount - 1
            For Each label In InfoForm.Controls
                If TypeName(label) = "Label" Then
                    With ActiveSheet
                        i = i + 1

                        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row + IIf(i = 1, 1, 0)
                        lastColumn = .Cells(i, .Columns.Count).End(xlToLeft).Column

                        If label <> "Chapter" Then
                            .Cells(lastColumn, i).Value = "Chapter " & ctr

                            .Cells(lastRow, i).Value = label.Caption
                        End If
                    End With
                End If
            Next
        Next

我尝试过这样合并

.Range(Cells(1, lastColumn), Cells(1,i)).Merge

但它将所有重复的章节合并成一个单元格

But it merges all the repeating chapters into one cell instead

预期结果：

Expected Result:

推荐答案

我的方法是在下面

   Dim label As Control
    Dim itm As Object
    For ctr = 1 To InfoForm.Chapter.ListCount - 1
        For Each label In InfoForm.Controls
            If TypeName(label) = "Label" Then
                With ActiveSheet
                    i = i + 1

                    lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row + IIf(i = 1, 1, 0)
                    lastColumn = .Cells(i, .Columns.Count).End(xlToLeft).Column

                    If label <> "Chapter" Then
                        .Cells(lastColumn, i).Value = "Chapter " & ctr

                        .Cells(lastRow, i).Value = label.Caption
                    End If
                End With
            End If
        Next
    Next

    'this is merge method
    Dim rngDB As Range, rng As Range, n As Integer

    Application.DisplayAlerts = False
    Set rngDB = Range("a1", Cells(1, Columns.Count).End(xlToLeft))
    For Each rng In rngDB
        If rng <> "" Then
            n = WorksheetFunction.CountIf(rngDB, rng)
            rng.Resize(1, n).Merge
            rng.HorizontalAlignment = xlCenter
        End If
    Next rng
    Application.DisplayAlerts = True

这篇关于Excel VBA：合并一个循环内的范围的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！