O、Q列公式的第一个计算结果显示错误

13782671637

lsdongjh 发表于 2018-4-28 12:03

这是老师19楼代码显示的计算结果的截图：

  出现问题的是C:E列条件区域指定数据的代码。应该按照12楼里C:E列的要求编写代码。

lsdongjh

你先看懂我的代码再说，OK？

1. Public Function YILOUHH(rgSource As Range, Optional rgConditions As Range)
   
2.     Application.Volatile True
   
3.     Dim arrSource As Variant, arrResult As Variant
   
4.     Dim objFind As Object
   
5.    
   
6.     Dim lngRow As Long
   
7.    
   
8.     arrSource = rgSource
   
9.     ReDim arrResult(LBound(arrSource) To UBound(arrSource), 1 To 1)
   
10.     Set objFind = CreateObject("Scripting.Dictionary")
    
11.    
    
12.     ''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
13.     '如果有条件，进行数据规整
    
14.     If Not (rgConditions Is Nothing) Then
    
15.         '只有一个条件单元格
    
16.         If rgConditions.Count = 1 Then
    
17.             For lngRow = LBound(arrSource) To UBound(arrSource)
    
18.                 If arrSource(lngRow, 1) <> rgConditions.Value Then
    
19.                     arrSource(lngRow, 1) = ""
    
20.                 End If
    
21.             Next
    
22.         End If
    
23.         
    
24.         '有三个条件单元格
    
25.         If rgConditions.Count = 3 Then
    
26.             '只有第一个单元格有值，同只有一个条件单元格
    
27.             If rgConditions(1) <> "" And rgConditions(2) = "" And rgConditions(3) = "" Then
    
28.                 For lngRow = LBound(arrSource) To UBound(arrSource)
    
29.                     If arrSource(lngRow, 1) <> rgConditions(1).Value Then
    
30.                         arrSource(lngRow, 1) = ""
    
31.                     End If
    
32.                 Next
    
33.             End If
    
34.             
    
35.              '前两个单元格有值,或者的关系
    
36.             If rgConditions(1) <> "" And rgConditions(2) <> "" And rgConditions(3) = "" Then
    
37.                 For lngRow = LBound(arrSource) To UBound(arrSource)
    
38.                     If arrSource(lngRow, 1) = rgConditions(1).Value Or arrSource(lngRow, 1) = rgConditions(2).Value Then
    
39.                         arrSource(lngRow, 1) = "A"
    
40.                     Else
    
41.                         arrSource(lngRow, 1) = ""
    
42.                     End If
    
43.                 Next
    
44.             End If
    
45.            
    
46.              '三个单元格都有值,或者的关系
    
47.             If rgConditions(1) <> "" And rgConditions(2) <> "" And rgConditions(3) <> "" Then
    
48.                 For lngRow = LBound(arrSource) To UBound(arrSource)
    
49.                     If arrSource(lngRow, 1) = rgConditions(1).Value Or arrSource(lngRow, 1) = rgConditions(2).Value Or arrSource(lngRow, 1) = rgConditions(3).Value Then
    
50.                         arrSource(lngRow, 1) = "A"
    
51.                     Else
    
52.                         arrSource(lngRow, 1) = ""
    
53.                     End If
    
54.                 Next
    
55.             End If
    
56.            
    
57.             
    
58.             '一、三单元格有值，按>=1 且 <=3 规整
    
59.             If rgConditions(1) <> "" And rgConditions(2) = "" And rgConditions(3) <> "" Then
    
60.                 For lngRow = LBound(arrSource) To UBound(arrSource)
    
61.                     If arrSource(lngRow, 1) >= rgConditions(1) And arrSource(lngRow, 1) <= rgConditions(3) Then
    
62.                         arrSource(lngRow, 1) = "A"
    
63.                     Else
    
64.                         arrSource(lngRow, 1) = ""
    
65.                     End If
    
66.                 Next
    
67.             End If
    
68.         End If
    
69.         
    
70.     End If
    
71.    
    
72.     '数据规整完毕
    
73.     '==============================================
    
74.    
    
75.     '''''''''''''''''''''''''''''''''''''''''''''''
    
76.     '数据查找计算
    
77.    
    
78.     For lngRow = LBound(arrSource) To UBound(arrSource)
    
79.         arrResult(lngRow, 1) = ""
    
80.         If arrSource(lngRow, 1) <> "" Then
    
81.             If objFind.Exists(arrSource(lngRow, 1)) = True Then
    
82.                 arrResult(lngRow, 1) = lngRow - objFind(arrSource(lngRow, 1))
    
83.             End If
    
84.             objFind(arrSource(lngRow, 1)) = lngRow
    
85.         End If
    
86.     Next
    
87.    
    
88.     Set objFind = Nothing
    
89.     YILOUHH = arrResult
    
90.    
    
91. End Function
    

复制代码

lsdongjh

你的要求中，最后的计算要求是一样的，所以，要将数据和计算分离！！，你的要求中，最繁琐的是数据的规整！！

lsdongjh

数据梳理的思路是：将符合要求的留下，并当做同一个字符对待，其他的删除！！！  现在的代码中，不知道如果没有条件，你怎么要求，所以默认是查找相同的，并计算行差

13782671637

lsdongjh 发表于 2018-4-28 12:58
你先看懂我的代码再说，OK？

老师：22楼的代码能够完美地实现12楼里关于条件区域的要求！谢谢老师的耐心付出。赠人玫瑰手留余香。祝老师工作顺利，快乐健康！请看22楼代码的计算结果的截图：

13782671637

lsdongjh 发表于 2018-4-28 13:06
数据梳理的思路是：将符合要求的留下，并当做同一个字符对待，其他的删除！！！  现在的代码中，不知道如果 ...

如果没有条件，默认是查找相同的，并计算行差。老师的猜测很正确！谢谢老师的热心帮忙！