【问题标题】:VBA - How to tag duplicate data based on given criteriaVBA - 如何根据给定条件标记重复数据
【发布时间】:2016-03-11 02:56:20
【问题描述】:

美好的一天!,我还是 VBA 的新手,任何帮助将不胜感激。 :)

我的问题是,我正在使用 VBA 生成报告,现在我需要在特定列中获取相同数据并在最后一列添加另一列以根据给定标准对其进行标记..

这是标准:

  1. 每月至少有一个“相同数据”(最长 3 个月)
  2. 自安装日期起 15 天内“相同数据”
  3. 30天内超过3个“相同数据”
  4. 30 天内 2 个或更多“更换调制解调器”

注意:相同的数据在列(服务编号)和标准 4 中

例如:

Completed-date | Installed-date  | Service# | Status       | Tag |
03/03/2016     | 03/03/2016      | 1111     | repaired     |     |
04/04/2016     | 04/04/2016      | 1111     | defective    |     |
05/05/2016     | 05/06/2016      | 1111     | defective    |     |
06/06/2016     | 06/07/2016      | 2222     | repaired     |     |
07/07/2016     | 07/07/2016      | 3333     | defective    |     |
08/08/2016     | 08/08/2016      | 4444     | change modem |     |
08/09/2016     | 08/09/2016      | 4444     | change modem |     |

列标签仍然是空的,因为我们还没有选择标准, 现在示例输出是这样的..

输出:

Completed-date | Installed-date  | Service# | Status       | Tag |
03/03/2016     | 03/03/2016      | 1111     | repaired     |     |
04/04/2016     | 04/04/2016      | 1111     | defective    |     |
05/05/2016     | 05/06/2016      | 1111     | defective    |  1  |
06/06/2016     | 06/07/2016      | 2222     | repaired     |     |
07/07/2016     | 07/07/2016      | 3333     | defective    |     |
08/08/2016     | 08/08/2016      | 4444     | change modem |     |
08/09/2016     | 08/09/2016      | 4444     | change modem |  4  |

现在,正如您在标签(列)中看到的那样,我们根据标准选择了它,并且 我只根据最近完成的日期为每个重复标记一个数据。

  1. 每月至少有一个“相同数据(servicenumber)”(最长 3 个月)
  2. 自安装日期起 15 天内“相同数据”
  3. 30天内超过3个“相同数据(servicenumber)”
  4. 30 天内 2 个或更多“更换调制解调器”

这是我的代码,我的代码只确定行中的重复项,我不知道如何开始编写标准。请帮助我!...

Public Sub sample1()

Dim varCOMDate As Variant
Dim varServiceID As Variant
Dim varInstallationDate As Variant
Dim serviceIDRng As Range
Dim lastRow As Long
Dim matchFoundIndex As Long
Dim iCntr As Long

Set Sheet1 = Workbooks.Open(TextBox1.Text).Sheets(1)
lngLastRow = Sheet1.Range("A" & wksht.Rows.Count).End(xlUp).Row
Set serviceIDRng = wksht.Range("C1:C" & lngLastRow)


 For iCntr = 1 To lastRow
   If Cells(iCntr, 1) <> "" Then
   matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 1), Range("A1:A" & lastRow), 0)

   If iCntr <> matchFoundIndex Then
     Cells(iCntr, 2) = "Duplicate" (I want to start the loop of dates here)

   End If
  End If
 Next

 End Sub

【问题讨论】:

  • 我不清楚您的标准系统是如何工作的,因为我看不出为什么要标记某些东西,或者为什么它会得到您给出的标记。你能澄清一下吗?
  • 是的,感谢您回答我的问题,并对我的困惑问题感到抱歉,标签号基于此标准。 1. 每月至少1个“相同数据(servicenumber)”(最长3个月) 2. 自安装日期起15天内“相同数据” 3. 30天内超过3个“相同数据(servicenumber)” 4. 2或更多“更改调制解调器”在 30 天内标记为 1 和 4,因为它符合该标准
  • 是的,您在问题中陈述了这些标准,但我不明白您的意思,尤其是在您如何在示例输出中声明标签 14 时.为什么带有标签4 的行被这样标记?整个表中只有 2 个条目具有 Service#4444 - 那么这 4 个来自哪里?
  • 标记为 1 到 4 的列表是您使用的标签吗?我认为这是一个必须满足所有条件的列表。
  • 假设,在下面的示例中,服务编号 1111 重复 3 次,但日期相隔一个月,此示例将属于标准 1,即 1。至少一个“相同数据( servicenumber)" 每月(最多 3 个月),因为服务号在 3 个月内重复

标签: vba excel


【解决方案1】:

这是一个帮助你的sn-p。它并不完整,它几乎没有考虑异常数据。您也没有充分指定标准,例如如果有几行满足标准应该发生什么,例如在 3 个月内出现 5 次“1111”。

您将不得不根据您需要的特定标准更改代码(或将其用作做其他事情的灵感)。

Sub duplicateTaggerExample()
    Dim startRng As Range, currRng As Range
    Dim first1Var As Date, second1Var As Date, third1Var As Date

    Set startRng = Range("C2")
    Set currRng = startRng

    Do While (Not currRng Is Nothing And currRng.Value <> "")
        Select Case currRng.Value
            Case "1111"
                ' Test if we're beyond the criteria - if so, reset vars and skip
                If (CDate(currRng.Value) - firstVar) > 90 Then
                    first1Var = ""
                    second1Var = ""
                    third1Var = ""
                    GoTo SkipIteration
                End If

                ' If we haven't skipped the iteration, it means the criteria is still viable, so we need to proceed with the comparison
                If first1Var <> "" And second1Var <> "" Then
                    ' If both first and second vars are filled, we fill the third.
                    ' We can do this without further comparison, because we already checked if we're inside the window for the criteria or not.
                    third1Var = CDate(currRng.Value)
                ElseIf firstVar <> "" Then
                    ' If only the first var is filled, fill the 2nd var.
                    second1Var = CDate(currRng.Value)
                Else
                    ' Should never happen, but...
                    Debug.Print "Some error"
                End If

                ' If the third var is filled, criteria is matched and we need to mark the occurrence and reset vars
                If third1Var <> "" Then
                    currRng.Offset(0, 2).Value = "1"
                    first1Var = ""
                    second1Var = ""
                    third1Var = ""
                End If
            Case "2222"
                ' Fill these as well, but the criteria are different so you will have to use different code than the above
            Case "3333"

            Case "4444"

            Case Else
                ' something
        End Select
SkipIteration:
    Loop
End Sub

【讨论】:

  • 谢谢@Vegard 我真的很感谢你的努力! :) 真的很抱歉,我不太擅长解释...
  • 我正在使用 VBA 生成报告,该报告的内容是故障单,所以现在这些故障单有很多列和数据,我的参考列是服务编号。服务号码重复的原因是 servicenumber=telephonenumber 的所有者有投诉,因此将创建票证。该计划的主要目的是根据给定的标准修复这些投诉,即 4.
  • 我收集了很多,但我的意思是,您没有指定程序应如何按照您的标准运行。例如,许多标准都有“至少 X”之类的东西,但是如果 X 的数量超过了最小数量呢?如果每月有 10 个实例怎么办?我们是只标记最后一次出现,还是除第 2 次之外的所有出现?
  • 就像我在答案中所说的那样,解决方案并不完整 - 这是一个关于如何开始的例子。在不了解更多标准的情况下做更多的工作是没有意义的,回复:我在上面的评论。你应该试着理解我的代码在做什么,看看你是否能提出如何让它像你想要的那样工作的建议。
  • 我认为标准的方法不正确,1. 每月至少一张票(最多 3 个月)一张票意味着故障票,例如我的手机有问题然后我打电话给客服现在将创建一个故障单,该故障单将在我正在使用的源文件中。所以基本上如果我是前任。过去 3 个月每月至少有一张票,它将被标记为 1。我希望它不会混淆
【解决方案2】:

@Vegard,我希望你不介意我在你之后发布答案,但我一直在看这篇文章的扩展,我觉得其中有很多值得其他人学习的地方。

@&A65726F,我的某些回答可能看起来有点鲁棒,容我们说吧,所以通过橄榄枝,我在下面发布了一些代码,可以帮助您解决这个问题。

好的,所以...

  1. 我想知道您是否对项目的架构考虑得足够多。就目前而言,工作表数据需要进行大量验证,并且输入错误的范围很大,可能会弄乱您的代码。例如,依靠正确键入和正确大小写的“更改调制解调器”,以及正确格式和正确排序的日期,要求非常高。如果数据是从数据库导入的,那么 Excel VBA 是处理数据的最合适的地方吗?如果没有,那么如果您可以将其中一些字段转换为索引值(例如“更改调制解调器”= 0 等),那么您的生活会简单得多。在我看来,使用此电子表格通知设计他们公司的客户服务战略。
  2. 尝试在 VBA 中使用工作表函数来执行此任务会使代码相当笨拙,尤其是在第 1 点数据不可靠的情况下。如果可能,从工作表中读取数据,在 VBA 中运行适当的算法,然后将结果写回工作表。下面的示例绝不是最有效的示例,但为了让您了解一下,我已经从工作表中读取了数据,然后按 Collection 中的 ServiceNumber 将其分组。如果我要花时间在这项任务上,我可能也会把它放入日期的子组中。
  3. Stackoverflow:如果你能在表达你的问题之前非常准确地表达你的想法,那真的很有帮助。您可以从 'to and fro' cmets 字符串中看到,您的问题中没有足够的信息。如果是这种情况,请仔细阅读人们的 cmets 并返回并编辑您的问题。 Vegard 已多次要求您完善您的标准,但您仍然没有这样做。他还要求你仔细阅读他的代码并确保你理解它,但你只是继续不停地回复他。这里的每个人都想提供帮助,许多人都是各自领域的专家;如果他们说他们需要更多信息或需要做其他事情,那么听取他们的意见确实是明智的。 Stackoverflow 不是来为您编写代码的,而是来帮助指导您并克服障碍的。

下面是一些将开始攻击您的问题的代码。我已将其分解为小的模块化块,以便您可以查看每个部分的功能,并且可以随时扩展它们,例如有一个单独的数据验证例程。我不打算为你写你的项目,所以请自己花一些时间来完成它。这个想法是您在完善标准和扩展数据验证时自己添加。将此代码粘贴到Module

Option Explicit
'Worksheet constants
Private Const SHEET_NAME As String = "Sheet1"
Private Const COMPLETED_DATE_COL As Long = 1
Private Const INSTALLED_DATE_COL As Long = 2
Private Const SERVICE_NUM_COL As Long = 3
Private Const STATUS_COL As Long = 4
Private Const TAG_COL As Long = 5
Private Const START_ROW As Long = 2

'Status constants
Private Const REPAIRED_ID As Integer = 0
Private Const DEFECTIVE_ID As Integer = 1
Private Const CHANGE_MODEM_ID As Integer = 2

'Tag test constants for variant array
Private Const T1_HIT_ID As Integer = 0
Private Const T2_HIT_ID As Integer = 1
Private Const T3_HIT_ID As Integer = 2
Private Const T4_HIT_ID As Integer = 3
Private Const ROW_ID As Integer = 4
Private Const COMPLETED_DATE_ID As Integer = 5
Private Const INSTALLED_DATE_ID As Integer = 6
Private Const SERVICE_COUNT_ID As Integer = 7
Private Const MODEM_COUNT_ID As Integer = 8

Private mStatusList As Collection

Public Sub RunMe()

    'Run this once
    Initialise

    Dim data As Variant
    Dim result As Variant

    'Run each time you set the tags
    data = ReadData
    result = GetTagTests(data)
    WriteData result


End Sub

Private Sub Initialise()

    'Set the allowable list of status definitions
    Set mStatusList = New Collection
    mStatusList.Add REPAIRED_ID, "repaired"
    mStatusList.Add DEFECTIVE_ID, "defective"
    mStatusList.Add CHANGE_MODEM_ID, "change modem"

End Sub

Private Function ReadData() As Variant
    Dim endRow As Long
    Dim data As Variant

    'Read the data to variant
    With ThisWorkbook.Worksheets(SHEET_NAME)
        endRow = .Cells(.Rows.Count, SERVICE_NUM_COL).End(xlUp).Row
        data = .Range(.Cells(START_ROW, COMPLETED_DATE_COL), .Cells(endRow, STATUS_COL)).Value2
    End With

    ReadData = data
End Function

Private Sub WriteData(data As Variant)

    'Size the range and pass in the array
    With ThisWorkbook.Worksheets(SHEET_NAME)
        .Cells(START_ROW, TAG_COL).Resize(UBound(data, 1), UBound(data, 2)).value = data
    End With
End Sub

Private Function GetTagTests(data As Variant) As Variant
    Dim serviceItems As Collection
    Dim rowData As Variant
    Dim tagResults() As Variant
    Dim tagTests As Variant
    Dim tagParams(0 To 8) As Variant
    Dim refDate As Date
    Dim r As Long

    'Dimension the output array
    ReDim tagResults(1 To UBound(data, 1), 1 To 1)

    'Loop through the data to assess for the tag criteria
    Set serviceItems = New Collection
    For r = 1 To UBound(data, 1)

        'Validate the data
        rowData = ValidatedRow(data, r)

        If Not IsEmpty(rowData) Then

            'Acquire tag params for this service number
            tagTests = Empty
            On Error Resume Next
            tagTests = serviceItems(rowData(SERVICE_NUM_COL))
            On Error GoTo 0

            If IsEmpty(tagTests) Then 'it's a new service number
                tagParams(T1_HIT_ID) = False
                tagParams(T2_HIT_ID) = False
                tagParams(T3_HIT_ID) = False
                tagParams(T4_HIT_ID) = False
                tagParams(ROW_ID) = r
                tagParams(COMPLETED_DATE_ID) = rowData(COMPLETED_DATE_COL)
                tagParams(INSTALLED_DATE_ID) = rowData(INSTALLED_DATE_COL)
                tagParams(SERVICE_COUNT_ID) = 1
                tagParams(MODEM_COUNT_ID) = IIf(rowData(STATUS_COL) = CHANGE_MODEM_ID, 1, 0)
                serviceItems.Add tagParams, rowData(SERVICE_NUM_COL)
            Else

                'Run the first test
                refDate = DateAdd("m", 3, tagTests(COMPLETED_DATE_ID))
                If rowData(COMPLETED_DATE_COL) < refDate Then
                    tagTests(T1_HIT_ID) = True
                Else
                    If tagTests(T1_HIT_ID) Then
                        tagResults(tagTests(ROW_ID), 1) = 1
                    End If
                    tagTests(T1_HIT_ID) = False
                End If

                'Run the second test
                refDate = DateAdd("d", 15, tagTests(INSTALLED_DATE_ID))
                If rowData(COMPLETED_DATE_COL) < refDate Then
                    tagTests(T2_HIT_ID) = True
                Else
                    If tagTests(T2_HIT_ID) Then
                        tagResults(tagTests(ROW_ID), 1) = 2
                    End If
                    tagTests(T2_HIT_ID) = False
                End If

                'Run the third test
                refDate = DateAdd("d", 30, tagTests(COMPLETED_DATE_ID))
                If rowData(COMPLETED_DATE_COL) < refDate Then
                    If tagTests(SERVICE_COUNT_ID) >= 3 Then
                        tagTests(T3_HIT_ID) = True
                    Else
                        tagTests(T3_HIT_ID) = False
                    End If
                Else
                    tagTests(SERVICE_COUNT_ID) = 0
                End If

                'Run the fourth test
                If rowData(COMPLETED_DATE_COL) < refDate Then
                    If tagTests(MODEM_COUNT_ID) >= 1 Then
                        tagTests(T4_HIT_ID) = True
                    Else
                        tagTests(T4_HIT_ID) = False
                    End If
                Else
                    tagTests(MODEM_COUNT_ID) = 0
                End If

                'Update the values
                tagTests(COMPLETED_DATE_ID) = rowData(COMPLETED_DATE_COL)
                tagTests(ROW_ID) = r
                tagTests(INSTALLED_DATE_ID) = rowData(INSTALLED_DATE_COL)
                tagTests(SERVICE_COUNT_ID) = tagTests(SERVICE_COUNT_ID) + 1
                tagTests(MODEM_COUNT_ID) = tagTests(MODEM_COUNT_ID) + IIf(rowData(STATUS_COL) = CHANGE_MODEM_ID, 1, 0)

                'Update the collection with the new tag test params
                serviceItems.Remove rowData(SERVICE_NUM_COL)
                serviceItems.Add tagTests, rowData(SERVICE_NUM_COL)
            End If
        End If

    Next

    'Catch all the outstanding hits
    For Each tagTests In serviceItems

        If tagTests(T1_HIT_ID) Then
            tagResults(tagTests(ROW_ID), 1) = 1
        End If
        If tagTests(T2_HIT_ID) Then
            tagResults(tagTests(ROW_ID), 1) = 2
        End If
        If tagTests(T3_HIT_ID) Then
            tagResults(tagTests(ROW_ID), 1) = 3
        End If
        If tagTests(T4_HIT_ID) Then
            tagResults(tagTests(ROW_ID), 1) = 4
        End If

    Next

    GetTagTests = tagResults

End Function
Private Function ValidatedRow(data As Variant, r As Long) As Variant
    Dim d As Date
    Dim str As String
    Dim i As Integer
    Dim result(1 To 4) As Variant

    'Test each of the values for correct types
    On Error Resume Next
    d = CDate(data(r, COMPLETED_DATE_COL))
    result(COMPLETED_DATE_COL) = d

    d = CDate(data(r, INSTALLED_DATE_COL))
    result(INSTALLED_DATE_COL) = d

    str = CStr(data(r, SERVICE_NUM_COL))
    result(SERVICE_NUM_COL) = str

    i = mStatusList(CStr(data(r, STATUS_COL)))
    result(STATUS_COL) = i

    'But there's a lot more validating that ought to be done, eg
    'dates in sequence, completed before installed, etc.

    If Err.Number = 0 Then
        ValidatedRow = result
    Else
        ValidatedRow = Empty
    End If
    On Error GoTo 0

End Function

【讨论】:

  • 很好的答案,而且您的解决方法肯定是全面的。根据我对 OP 希望如何计算标准的理解,您的方法可能会比我的更好。
  • @Vegard,是的,我对想要写第 3 点感到难过——尽管我也觉得需要说明这一点——所以我想我最好通过报答的方式来做一个全面的回答!
猜你喜欢
  • 1970-01-01
  • 2022-12-06
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 2023-02-04
  • 2023-02-23
  • 1970-01-01
  • 1970-01-01
相关资源
最近更新 更多