@Vegard,我希望你不介意我在你之后发布答案,但我一直在看这篇文章的扩展,我觉得其中有很多值得其他人学习的地方。
@&A65726F,我的某些回答可能看起来有点鲁棒,容我们说吧,所以通过橄榄枝,我在下面发布了一些代码,可以帮助您解决这个问题。
好的,所以...
- 我想知道您是否对项目的架构考虑得足够多。就目前而言,工作表数据需要进行大量验证,并且输入错误的范围很大,可能会弄乱您的代码。例如,依靠正确键入和正确大小写的“更改调制解调器”,以及正确格式和正确排序的日期,要求非常高。如果数据是从数据库导入的,那么 Excel VBA 是处理数据的最合适的地方吗?如果没有,那么如果您可以将其中一些字段转换为索引值(例如“更改调制解调器”= 0 等),那么您的生活会简单得多。在我看来,使用此电子表格通知设计他们公司的客户服务战略。
- 尝试在 VBA 中使用工作表函数来执行此任务会使代码相当笨拙,尤其是在第 1 点数据不可靠的情况下。如果可能,从工作表中读取数据,在 VBA 中运行适当的算法,然后将结果写回工作表。下面的示例绝不是最有效的示例,但为了让您了解一下,我已经从工作表中读取了数据,然后按
Collection 中的 ServiceNumber 将其分组。如果我要花时间在这项任务上,我可能也会把它放入日期的子组中。
- 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