恳请高手出手帮忙，条件比较复杂，数据量也比较大，感激不尽！

xvbwily

示例文件上传，相关条件要求在说明里，再次感谢！

microyip

这种伸手党的忙……

lsdongjh

1. Option Explicit
   
2. 
   
3. Sub Test()
   
4.     Dim sh As Worksheet, arrData As Variant, arrResult As Variant, lngRow As Long
   
5.     Dim rgData As Range, rgSortA As Range, rgSortB As Range
   
6.     Dim strGantryID As String, strPreGantryID As String '门架编号
   
7.     Dim strCarID As String, strPreCarID As String '车牌号码
   
8.     Dim dateTradeTime As Date '交易时间
   
9.     Dim datePreTime As Date '前一个交易时间
   
10.     Dim dblMoney As Double '交易金额
    
11.     Dim strState As String '交易状态
    
12.     Dim lngAllowableDiff As Long '容许的时间差
    
13.     Dim lngDiff As Long '时间差
    
14.         
    
15.     Set sh = Sheets("原始数据") ' 操作的表名
    
16.     '排序
    
17.     Set rgData = sh.UsedRange '排序区域，全表
    
18.     Set rgSortA = sh.Range("D1") '第一个排序字段，车牌号码
    
19.     Set rgSortB = sh.Range("I1") '第二个排序字段，交易时间
    
20.     rgData.Sort key1:=rgSortA, order1:=xlAscending, key2:=rgSortB, order2:=xlAscending, Header:=xlYes
    
21. 
    
22.     lngAllowableDiff = 10 '容许的时间差 为 10分钟
    
23. 
    
24.     arrData = rgData '区域转数组
    
25.     ReDim arrResult(LBound(arrData) To UBound(arrData), 1 To 1) As String '定义结果数组
    
26.     Set rgData = Nothing:    Set rgSortA = Nothing:    Set rgSortB = Nothing
    
27.    
    
28.     Set rgData = sh.Range("P1") '结果返回列
    
29.    
    
30.     '从第2行开始判断
    
31.     For lngRow = LBound(arrData) + 1 To UBound(arrData)
    
32.         strGantryID = Trim(arrData(lngRow, 2)) '门架编号
    
33.         
    
34.         strCarID = arrData(lngRow, 4) '车牌号码
    
35.         
    
36.         dateTradeTime = CDate(arrData(lngRow, 9)) '交易时间
    
37.         
    
38.         dblMoney = Val(arrData(lngRow, 7))  '交易金额
    
39.         strState = arrData(lngRow, 10) '交易状态
    
40.         
    
41.         If lngRow > LBound(arrData) + 1 Then
    
42.             strPreGantryID = Trim(arrData(lngRow - 1, 2)) '前一个门架编号
    
43.             strPreCarID = arrData(lngRow - 1, 4) '上一行车牌号码
    
44.             datePreTime = CDate(arrData(lngRow - 1, 9)) '前一个交易时间
    
45.         End If
    
46.         
    
47.         lngDiff = Abs(DateDiff("n", dateTradeTime, datePreTime)) '时间差
    
48.         
    
49.         '如果交易状态 为 失败，则处理
    
50.         If strState = "交易失败" Then
    
51.             arrResult(lngRow, 1) = CheckState(strCarID, strPreCarID, strGantryID, strPreGantryID, dblMoney, lngAllowableDiff, lngDiff)
    
52.         End If
    
53.     Next
    
54.    
    
55.    
    
56.     rgData.Resize(UBound(arrResult), 1) = arrResult
    
57. End Sub
    
58. 
    
59. 
    
60. Function CheckState(strCarID As String, strPreCarID As String, strGantryID As String, strPreGantryID As String, dblMoney As Double, lngAllowableDiff As Long, lngDiff As Long) As String
    
61.     Dim strGantryID_15 As String, strGantryID_14 As String '门架编号前15位 为 通道，前14位为 出入口
    
62.     Dim strPreGantryID_15 As String, strPreGantryID_14 As String
    
63.    
    
64.     '所有车牌号码为“默A00000”的，返回：“无车牌”
    
65.     If strCarID = "默A00000" Then
    
66.         CheckState = "无车牌"
    
67.         Exit Function
    
68.     End If
    
69.    
    
70.     strGantryID_15 = Mid(strGantryID, 1, 15) '门架编号前15位 为 通道
    
71.     strGantryID_14 = Mid(strGantryID, 1, 14)  '门架编号前14位为 出入口
    
72.     strPreGantryID_15 = Mid(strPreGantryID, 1, 15) '门架编号前15位 为 通道
    
73.     strPreGantryID_14 = Mid(strPreGantryID, 1, 14)  '门架编号前14位为 出入口
    
74.     '车牌号码相同的连续两条数据，一条交易成功，一条交易失败，且门架名称是相反的,时间在
    
75.     '返回“反向感应”
    
76.     If strCarID = strPreCarID Then '上下两条记录，车号相同
    
77.         If strGantryID_15 = strPreGantryID_15 Then '通道相同
    
78.             If lngDiff <= lngAllowableDiff Then '在容许的时间差内
    
79.                 CheckState = "重复读取"
    
80.                 Exit Function
    
81.             End If
    
82.         Else
    
83.             '出入口相同，并在容许的时间差内
    
84.             If strGantryID_14 = strPreGantryID_14 And lngDiff <= lngAllowableDiff Then
    
85.                 CheckState = "反向感应"
    
86.                 Exit Function
    
87.             End If
    
88.         End If
    
89.     End If
    
90.    
    
91.     '有交易金额，但显示交易失败,返回：“扣款失败”
    
92.     If dblMoney > 0 Then
    
93.         CheckState = "扣款失败"
    
94.         Exit Function
    
95.     End If
    
96.    
    
97.     CheckState = "****原因未知***"
    
98.    
    
99. End Function
    

复制代码

Q155133209

microyip 发表于 2020-1-2 12:27
这种伸手党的忙……

  这种他就是找代工 别人估计都要开高价。判断条件太繁琐

wdx223

要求很明确，值得鼓励，坐等大佬分享结果

xvbwily

lsdongjh 发表于 2020-1-2 13:34

感谢感谢。我水平不高，正在尝试使用。稍后反馈结果再次感谢

xvbwily

microyip 发表于 2020-1-2 12:27
这种伸手党的忙……

我确实不会vba，如有打扰，只能说抱歉

xvbwily

lsdongjh 发表于 2020-1-2 13:34

感谢您 的热情相助，正是我想要的结果。