如何检查列中是否存在重复值，然后合并发现的相邻列? [英] How to check column for duplicate values, then merge adjacent columns if found?

问题描述

我正在尝试创建一个宏，该宏检查一列中是否有重复值，然后在找到后合并这些行.

I am trying to create a macro that checks for duplicate values in a column, then merges those rows if found.

我尝试使用循环检查每个单元格和 cell.Offset(1,0)，如果它们相等，则将它们合并.然后将格式从该列复制到相邻列.

I have tried using a loop to check each cell and cell.Offset(1,0) and if they are equal, merge them. Then copy the formatting from that column to an adjacent column.

此图显示了我要完成的工作.

This image shows what I am trying to accomplish.

我仅尝试合并一列(E)，但问题是它一次只检查两个单元格，因此它不会合并5个相同值.如果最后一行被合并，它也会弄乱.选中的列合并后，我将要将格式复制到相邻的适当列中.

I am only trying to merge one column (E) but the issue is it only checks two cells at a time, so it doesnt merge 5 of the same values. It also messes up if the last row is merged. Once the checked column is merged I am just going to copy formatting to the adjacent appropriate columns.

Sub Merge()

Dim lastRow As Long
lastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

Application.DisplayAlerts = False

    For Each cell In Range("E1:E" & lastRow)
        If cell.Offset(1, 0).Value = cell.Value Then
           Range(cell, cell.Offset(1, 0)).Merge
        End If
    Next cell
End Sub

推荐答案

垂直合并单元格

此代码检查每行的单元格并垂直合并单元格(如果它们具有相同的值)(公式也具有相同的结果值！):

merge cells vertically

This code checks the cells of each row and merges cells vertically, if they have the same value (also formulas whith same resulting value!):

Sub MergeCellsVertically()
    Dim ws As Worksheet
    Dim currentRng As Range
    Dim usedRows As Long, usedColumns As Long
    Dim currentRow As Long, currentColumn As Long
    
    Set ws = ActiveSheet
    usedRows = ws.Cells.Find(What:="*", After:=ws.Cells(1), LookIn:=xlFormulas, _
        SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    usedColumns = ws.Cells.Find(What:="*", After:=ws.Cells(1), LookIn:=xlFormulas, _
        SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    
    Application.DisplayAlerts = False
    For currentColumn = 1 To usedColumns
        For currentRow = usedRows To 2 Step -1
            Set currentRng = ws.Cells(currentRow, currentColumn)
            If currentRng.Value <> "" Then
                If currentRng.Value = currentRng.Offset(-1, 0).Value Then
                    currentRng.Offset(-1, 0).Resize(2, 1).Merge
                End If
            End If
        Next currentRow
    Next currentColumn
    Application.DisplayAlerts = True
    
    Set currentRng = Nothing
    Set ws = Nothing
End Sub

如您的示例显示的结构不均匀，这可能是一个很好的解决方案.如果您只想决定要合并的相邻单元格的一行，请记住，只有合并区域左上单元格的内容才存活".

As your example shows a non-uniform structure, this may be a good solution. If you just want to decide by one row, which neighbor-cells to merge, keep in mind, that only the content of the upper left cell of a merged area "survives".

如果要处理合并区域的内容，那么 currentRng.MergeArea.Cells(1)将始终代表合并区域的第一个单元格，即内容所在的位置.

If you want to address the content of a merged area, then currentRng.MergeArea.Cells(1) will always represent the first cell of the merged area, where the content is.

Sub UnmergeCells()
    Dim ws As Worksheet
    Dim usedRows As Long, usedColumns As Long
    Dim currentRng As Range, tempRng As Range
    Dim currentRow As Long, currentColumn As Long
    
    Set ws = ActiveSheet
    usedRows = ws.UsedRange.Cells(1).Row + ws.UsedRange.Rows.Count - 1
    usedColumns = ws.UsedRange.Cells(1).Column + ws.UsedRange.Columns.Count - 1
    
    For currentRow = 1 To usedRows
        For currentColumn = 1 To usedColumns
            Set currentRng = ws.Cells(currentRow, currentColumn)
            If currentRng.MergeCells Then
               Set tempRng = currentRng.MergeArea
               currentRng.MergeArea.UnMerge
               currentRng.Copy tempRng
            End If
        Next currentColumn
    Next currentRow
    
    Set tempRng = Nothing
    Set currentRng = Nothing
    Set ws = Nothing
End Sub

由于 Find 函数很难找到合并单元格中最后使用的列或行，因此我改用标准的 UsedRange .请注意，未合并(重复)的公式可能是意外的.

As the Find function is bad in finding the last used column or row in merged cells, I use the standard UsedRange instead. Be aware, that unmerged (duplicated) formulas may be unexpected.

这篇关于如何检查列中是否存在重复值，然后合并发现的相邻列?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！