如何检查列有重复值,这时如果发现合并相邻列?

问题描述 投票:0回答:1

我想创建一个列是否有重复值的宏,然后如果发现合并这些行。

我一直在使用一个循环来检查每个细胞和cell.Offset(1,0)尝试,如果他们是平等的,将它们合并。然后格式化从该列复制到相邻的列。

此图显示了什么,我试图完成。 enter image description here

我只是想合并一列(E),但问题是它一次只能检查两个单元,因此它不合并相同的值5。如果最后一行合并它也搅乱。一旦检查栏被合并,我只是要复制格式到邻近的相应列。

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
excel vba
1个回答
0
投票

merge cells vertically

此代码检查每个行的单元格和合并单元格垂直,如果他们有相同的值(也具有相同的结果值口诀!):

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

当你的例子显示了非均匀结构,这可能是一个很好的解决方案。如果你只是想通过一排,相邻细胞合并这,记住,只有合并区域的左上角单元格的内容“生存”来决定。

如果你想解决一个合并区域的内容,然后currentRng.MergeArea.Cells(1)始终表示合并后的地区,这里的内容是第一个单元格。

unmerge

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代替。要知道,未合并(复制)的公式可能出现意外。

© www.soinside.com 2019 - 2024. All rights reserved.