检查合并的单元格并比较相邻的单元格以从比较的单元格值中设置唯一值

Check merged cell and compare adjacent to set unique value from compared cells values

我在 Excel 2010 年写了一个宏来解决如下问题:
我有两列,一列带有键字符串值,一列带有 uuid。这个想法是每个键都应该只有一个 uuid,但正如现在的 table 一样,键单元格可以是合并单元格或单个单元格。 宏需要识别哪些单元格被合并,哪些没有,所以,我有两个选择:

所以基本上是检查合并的单元格 MergeArea 但我不知道我是否需要遍历其地址或检查范围内偏移量为 Offset(0,1) 的单元格或什么。 使用我的代码,我可以知道单元格是否已合并,但现在,我如何遍历它的相邻单元格值?

现在的代码:

Sub CopyUUID()
Dim lRow As Long
Dim rng As Range
Dim ws As Worksheet
Dim rMerged As Range
Dim value As Variant

Set ws = Sheets(ActiveSheet.Name)

On Error GoTo ExitProgram 'If an error happens within the execution, skips it and continue in next step
Application.DisplayAlerts = False 'We can cancel the procedure without errors

With ws
    lRow = .Range("F" & .Rows.count).End(xlUp).row
    Set rng = .Range(.Cells(3, 6), .Cells(lRow, 6))
    rng.Select
    For Each cell In rng
        If cell.MergeCells Then
            'Code for merged cells
        Else
            'Code to use for single cells
        End If
    Next cell
End With
ExitProgram:
   Exit Sub
End Sub

试试下面的代码。请注意,这将覆盖 UUID 的当前内容,因此在测试之前制作一个备份副本。如果您不想修改 UUID 列,您可以修改它以满足您的需要。

Sub CopyUUID()
    Dim lRow As Long
    Dim rng As Range
    Dim c As Range
    Dim ws As Worksheet
    Dim rMerged As Range
    Dim value As Variant

    Set ws = Sheets(ActiveSheet.Name)

    On Error GoTo ExitProgram 'If an error happens within the execution, skips it and continue in next step
    ' Application.DisplayAlerts = False 'We can cancel the procedure without errors

    With ws
        lRow = .Range("F" & .Rows.Count).End(xlUp).Row
        Set rng = .Range(.Cells(3, 6), .Cells(lRow, 6))
        ' rng.Select
        For Each c In rng

            If c.MergeCells Then
                'Code for merged cells
                c.Offset(0, 1).Formula = c.MergeArea.Cells(1, 1).Offset(0, 1).Formula
            Else
                'Code to use for single cells
                If c.Formula = c.Offset(-1, 0).Formula Then
                    c.Offset(0, 1).Formula = c.Offset(-1, 1).Formula
                End If
            End If
        Next c
    End With
    ExitProgram:
       Exit Sub
End Sub

在MergedCell 中时,它使UUID 与合并区域中第一个单元格的UUID 相同。当不在 MergedCell 中时,如果 Key 与上面的行相同,它会从上面的行复制 UUID。

我将您的变量 cell 更改为 c(我不喜欢使用可能与内置函数混淆的变量名称)并注释掉了几行。

希望对您有所帮助

我采用了一种简单的方法来解决这个问题,正如我采取的步骤所说明的那样。

  1. 示例 sheet 显示包含合并单元格和未合并单元格的数据。

  2. 运行 取消合并单元格的程序代码。程序的输出附在下面。

  1. 如果此数据结构符合您的情况,则为 B 列添加 2 行代码将保留下图所示的数据。

  1. 程序代码如下:

'不删除列:

Sub UnMergeRanges()
    Dim cl As Range
    Dim rMerged As Range
    Dim v As Variant

    For Each cl In ActiveSheet.UsedRange
        If cl.MergeCells Then
            Set rMerged = cl.MergeArea
            v = rMerged.Cells(1, 1)
            rMerged.MergeCells = False
            rMerged = v
        End If
    Next
End Sub
'With coumn deletion   
Sub UnMergeRangesB()
    Dim cl As Range
    Dim rMerged As Range
    Dim v As Variant

    For Each cl In ActiveSheet.UsedRange
        If cl.MergeCells Then
            Set rMerged = cl.MergeArea
            v = rMerged.Cells(1, 1)
            rMerged.MergeCells = False
            rMerged = v
        End If
    Next
    Columns("B:B").Select
    Selection.Delete Shift:=xlToLeft
End Sub
Option Explicit

Sub CopyUUID()

    Const UUID As Long = 31 'col AE

    Dim lRow As Long, cel As Range, isM As Boolean, copyID As Boolean, kCol As Long

    With ActiveSheet
        kCol = -25          'col F
        lRow = .Cells(.Rows.Count, UUID + kCol).End(xlUp).Row

        For Each cel In .Range(.Cells(3, UUID), .Cells(lRow, UUID))

            isM = cel.Offset(0, kCol).MergeCells
            copyID = isM And Len(cel.Offset(0, kCol)) = 0
            copyID = copyID Or (Not isM And cel.Offset(0, kCol) = cel.Offset(-1, kCol))

            If copyID Then cel = cel.Offset(-1)
        Next
    End With
End Sub