验证Excel中每个区域ID对应唯一零售价组合的VBA实现需求

嘿，我完全get到你的需求了——你要确保同一个区域ID（B列）对应的零售价（C列）是唯一的，不能出现同一个区域ID对应不同零售价的情况，对吧？网上搜的大多是找重复项的代码，刚好和你的需求反过来，我给你写个针对性的VBA方案，一步步来：

• 用Dictionary对象来存每个区域ID已经对应的零售价，字典的键天生唯一，刚好适合记录区域ID和它的“基准零售价”
• 遍历表格每一行数据，对比当前行的区域ID+零售价组合与字典里的记录
• 一旦发现同一个区域ID对应不同零售价，就把该行标记出来（比如填红背景），方便你快速定位问题

Sub CheckUniqueRegionPrice()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim regionDict As Object
    Dim currentRegion As String
    Dim currentPrice As Variant
    Dim existingPrice As Variant
    
    ' 这里改成你实际要操作的工作表名称，比如"商品价格表"
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    ' 创建字典对象
    Set regionDict = CreateObject("Scripting.Dictionary")
    
    ' 获取B列数据的最后一行（假设第1行是表头，数据从第2行开始）
    lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    
    ' 先清除之前的标记（避免残留旧的高亮）
    ws.Range("A2:C" & lastRow).Interior.ColorIndex = xlColorIndexNone
    
    ' 遍历每一行数据
    For i = 2 To lastRow
        currentRegion = ws.Cells(i, "B").Value
        currentPrice = ws.Cells(i, "C").Value
        
        ' 跳过空的区域ID或零售价，避免误判
        If currentRegion <> "" And Not IsEmpty(currentPrice) Then
            ' 如果字典里已经存过这个区域ID
            If regionDict.Exists(currentRegion) Then
                existingPrice = regionDict(currentRegion)
                ' 对比当前零售价和已记录的零售价是否不一致
                If currentPrice <> existingPrice Then
                    ' 把有问题的行（A-C列）背景标红，一眼就能看到
                    ws.Cells(i, "A").Resize(1, 3).Interior.Color = RGB(255, 199, 206)
                    ' 要是想弹窗提示具体问题，把下面这行注释取消就行
                    ' MsgBox "区域ID " & currentRegion & " 在第" & i & "行存在不一致的零售价！", vbExclamation
                End If
            Else
                ' 字典里没这个区域ID，就把它和对应的零售价存进去
                regionDict.Add currentRegion, currentPrice
            End If
        End If
    Next i
    
    ' 检查完成后给个提示
    MsgBox "检查搞定！不一致的行已经标红啦～", vbInformation
    
    ' 释放对象，好习惯
    Set regionDict = Nothing
    Set ws = Nothing
End Sub

1. 工作表适配：把代码里的Sheet1改成你自己的工作表名称，比如你的表叫“区域价格表”就改这个
2. 空值处理：自动跳过空的区域ID或零售价，不会把空值当成错误
3. 标记方式：默认用红色背景标记问题行，你也可以改成弹窗提示（取消代码里的注释就行）
4. 运行步骤：
   • 打开Excel，按Alt + F11打开VBA编辑器
   • 右键左侧的工作簿名称 → 插入 → 模块
   • 把代码粘贴进去，修改工作表名称
   • 按F5运行，或者回到Excel里通过「开发工具→宏」选择CheckUniqueRegionPrice运行

内容的提问来源于stack exchange，提问作者R.Mede