Excel 确认x行重复

我需要一个例程，可以确认每个条目有3行数据，但不知道从哪里开始。从下面的部分表格中可以看出，除了FrgQty和YOULT之外，每一行都是相同的。我只需要确认每个引号有3行，并给我一个消息框，其中包含没有3行的引号。电子表格中通常有1到100个引号，因此这将非常有用

---

假设您可以不使用需求中的消息框部分，那么您根本不需要VBA。只需向表中添加另一列，名为

Valid？

或其他内容，并给出以下公式：

=COUNTIF([Quote#],[@Quote#])=3

---

然后，您可以在

FALSE

上筛选该列，以查找有问题的行。

使用透视表，按引号分组，然后对同一引号列进行计数。这样，您可以在大约0.0003秒内看到有多少引号少于3行，并确定是哪一行。

您可以尝试使用dictionary对象执行此子例程。在屏幕截图中，您需要将“Sheet1”更改为工作表的名称，“Table1”更改为表的名称

Public Sub areThereThreeRowsForEachQuoteNum()
    Dim dict As Object
    Dim tbl As ListObject
    Dim quoteNumRange As Range

    Set dict = CreateObject("Scripting.Dictionary")
    Set tbl = Worksheets("Sheet1").ListObjects("Table1")
    Set quoteNumRange = tbl.ListColumns("Quote#").DataBodyRange.Cells

    'Create a dictionary of quote#, count pairs
    For Each cell In quoteNumRange
        If dict.Exists(cell.Value) = False Then
            dict.Add cell.Value, 1
        Else
            dict(cell.Value) = dict(cell.Value) + 1
        End If
    Next

    'Loop to check for any quote# in the dictionary with count < 3
    'If we find one, show a MsgBox with the problematic Quote#
    For Each key In dict
        If dict(key) < 3 Then
            MsgBox "Quote#" & key & " has only " & dict(key) & " rows."
        End If
    Next
End Sub

Public子区域有三行reachquotenum（）
作为对象的Dim dict
作为ListObject的Dim tbl
Dim QUOTENUMRANGAS范围
Set dict=CreateObject（“Scripting.Dictionary”）
Set tbl=工作表（“表1”）。列表对象（“表1”）
设置quoteNumRange=tbl.ListColumns（“Quote#”）.DataBodyRange.Cells
'创建引号#的字典，计数对
对于quoteNumRange中的每个单元格
如果dict.Exists（cell.Value）=False，则
添加单元格值，1
其他的
dict（cell.Value）=dict（cell.Value）+1
如果结束
下一个
'循环检查字典中计数小于3的任何引号#'
'如果我们找到一个，请显示带有问题报价的MsgBox#
对于dict中的每个键
如果dict（key）<3，则
MsgBox“Quote#”和key&“has only”&dict（key）和“rows”
如果结束
下一个
端接头

欢迎来到stackoverflow。请阅读发帖指南，否则你将获得否决票。为什么我们要否决他？我看不出他的问题有什么不对。标题是有效的，问题是明确的。如果你能指出我违反了指南的哪一部分，我将不胜感激，因为我没有看到它。谢谢。这并不完全符合我的需要，但它让我走上了正确的道路。我可以从这里开始。谢谢你的帮助。我已经想到了这一点，这将是可行的，但我正在尝试构建宏来帮助填充提案表单。透视表方法可能仍然有效。在您的记录中，您需要什么链接到您的提案表？这是另一个可行的选择，我可能需要看看。谢谢