Question

美好的一天！，我仍然是VBA的新人，任何帮助将不胜感激。：）

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

这是标准：

每月至少一个“相同数据”（最多3个月）
“安装日期后15天内的”相同数据“
30天内超过3个“相同数据”
在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  |

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

每月至少一个“相同的数据（服务对数）”（最多3个月）
“安装日期后15天内的”相同数据“
超过3“相同数据（服务编号）”30天内
在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

Answer 1

这是一个帮助你的片段。它不完整，几乎没有说明异常数据。您还没有充分指定标准，例如，如果有多个行满足条件，应该发生什么，例如5次出现＆＃34; 1111＆＃34;在3个月内。

您必须根据所需的具体标准更改代码（或将其用作启发其他内容的灵感）。

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

Answer 2

@Vegard，我希望你不介意我在你之后发布一个答案，但我一直在看这篇文章的扩展，我觉得有很多内容可供其他人学习。

@＆amp; A65726F，我的一些答案可能看起来有点，我们可以说是健壮的，所以通过橄榄枝我已经发布了一些代码，这将为你解决这个问题。

好的，所以......

我想知道你是否对项目的架构有足够的考虑。目前的工作表数据需要进行相当多的验证，输入错误的范围很大，可能会使代码陷入困境。例如，依赖于“更改调制解调器”以正确键入和正确装入，并且日期格式正确且排序正确，要求非常多。如果从数据库导入数据，那么Excel VBA是最适合操作数据的地方吗？如果没有，那么如果你可以将这些字段中的一些转换为索引值（例如“更改调制解调器”= 0等），那么你的生活会更简单。在我看来，使用这个电子表格通知设计他们公司的客户服务战略。
尝试在VBA中使用工作表函数来完成此任务将使代码变得相当笨拙，尤其是在第1点数据不可靠的情况下。如果可能，请从工作表中读取数据，在VBA中运行适当的算法，然后将结果写回工作表。我下面的示例绝不是最有效的，但是，为了给您一个想法，我已经从工作表中读取数据，然后在Collection内按ServiceNumber对其进行分组。如果我花时间完成这项任务，我可能也会把它放到日期的子组中。
Stackoverflow：如果你能在阐述问题之前准确地表达自己的想法，那确实会有所帮助。您可以从“来回”字符串中看到您的问题中没有足够的信息。如果是这种情况，请仔细阅读人们的评论并返回并编辑您的问题。 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

VBA - 如何根据给定条件标记重复数据

2 个答案: