时间戳

首页 > 解决方案 > 合并相同的单元格，循环遍历 Excel 表格的几列（listobject）

loops - 合并相同的单元格，循环遍历 Excel 表格的几列（listobject）

问题描述

我有一个宏生成一个新工作簿，在其中粘贴选择的数据，使其成为 Excel 表（listobject），从另一个表中添加数据等现在我正在尝试遍历整个表（工作）查看每个相同单元格的列以合并它们

Dim tableName As String
Dim tblcofin As Listobject
Dim v As Long, w As Long
Dim Rg1 As Range, Rg2 As Range
tableName = "CO_FIN"
Set tblcofin = ActiveSheet.ListObjects(tableName)

For v = 1 To Range("CO_FIN").Columns.Count
     For w = 1 To Range("CO_FIN").Rows.Count
            Set Rg1 = tblcofin.DataBodyRange.Cells(w, v)
            Set Rg2 = tblcofin.DataBodyRange.Cells(w + 1, v)

            If Rg1 = Rg2 And Rg1 <> "" Then
                tblcofin.Range(Rg1, Rg2).Merge
            End If
      Next w
 Next v

使用 Debug.Print 行，我能够确认它循环遍历我的整个表，它识别出同一列中的 2 个单元格何时相同，但我总是收到错误消息“应用程序定义或对象定义错误”（或另一个取决于我尝试过的替代方案）“范围（Rg1，Rg2）.Merge”

我试图： - 将 Rg1 和 Rg2 声明为 Variant 而不是 Range（在添加或不添加 .Address 的情况下设置它们） - 使用“Cells(Rg1, Rg2).Resize.Merge” - 以及多种或其他变体，我确定它是一些非常愚蠢的事情，但虽然我通常会自己找到解决方案，但经过数小时的尝试和浏览论坛，我真的很感激一些建议！（不知道如何上传示例文件，以防万一）

我也试过这个（改编自 JA Gomez）只是我的第一列，但无济于事:(（在“.Merge”行上仍然是同样的问题......）

Dim myFirstRow As Long
Dim myLastRow As Long
Dim myFirstColumn As Long
Dim myLastColumn As Long
Dim myWorksheet As Worksheet
Dim iCounter As Long
Dim iCounter2 As Long
    myFirstRow = 6
    myFirstColumn = 2
    myLastColumn = 5
    myLastRow = 21
    Set myWorksheet = Worksheets("Fin_conso")

    With myWorksheet
        For iCounter = myLastRow To myFirstRow Step -1
            iCounter2 = iCounter - 1
            If .Cells(iCounter, myFirstColumn).Value = Cells(iCounter - 1, myFirstColumn).Value Then
Debug.Print .Cells(iCounter, myFirstColumn).Address
                .Range(.Cells(iCounter, myFirstColumn), .Cells(iCounter2, myFirstColumn)).Merge
            End If
        Next iCounter
    End With

标签： loopsmergelistobject

解决方案

在花了几个小时寻找解决方案之后，我得到了一个令人震惊的启示：在 Excel 表格（listobject）中合并单元格是不可能的，它必须具有过滤器等值。希望这种经验至少可以帮助其他人浪费时间看起来像我在错误的方向！

所以我不得不取消列出表格以使其成为正常范围，并且只需要插入来自 Pk 的优秀代码在这里找到：

    Dim RgTable As Range
    Dim FirstRow As Long, LastRow As Long, FirstCol As Long, LastCol As Long

    Set RgTable = tblcofin.DataBodyRange 'To have a clear range to work from
    'Unlist the tblcofin table to make it just a normal table (not Listobject)
    tblcofin.Unlist

    'Select the range where to merge identical cells
    RgTable.Select

    'Merge identical cells
    Application.DisplayAlerts = False
    Dim RgM As Range
MergeCells:
        For Each RgM In Selection
            If RgM.Value = RgM.Offset(1, 0).Value And RgM.Value <> "" Then
                Range(RgM, RgM.Offset(1, 0)).Merge
                Range(RgM, RgM.Offset(1, 0)).HorizontalAlignment = xlCenter
                Range(RgM, RgM.Offset(1, 0)).VerticalAlignment = xlCenter
                GoTo MergeCells
            End If
        Next
        Application.DisplayAlerts = True

感谢社区：随着时间的推移，我从 stackoverflow 论坛学到了很多东西。赞赏！

推荐阅读