88万行的数据运算：如何编写代码来代替excel函数的运算，谢谢！

liulang0808

ak47ok 发表于 2014-9-13 11:27
在N列的红字范围的名称中、或有A列黄色区域名称（不一定全有）、谢谢！

j列的合计，用公式就可以了，其他的考虑用代码。。。

lipton

当你不知如何实现一个复杂的计算时，建议采用：面向功能组合的编程方式来解决。
1， 先给自己定一个起点，这个起点不一定是整个程序的第一个过程。
2，围绕着这个起点逐步添加过程（方法和函数），每个过程采用松耦合的方式连接
在设计过程中不要忙于优化，优化是等到调试结果正确之后再进行。

ak47ok

因为黄色区域的名称在N列中有可能是多次出现的，所以要通过A2的值来在M列定位，

问题有点繁杂、我只会通过excel函数加点辅助列计算出来，但要直接要VBA的代码来写、却一窍不通，
本想拆散来分几个问题请教，但又怕会影响老师的整体考虑。

麻烦老师费神！再将感谢！真心想学习，谢谢！

ak47ok

lipton 发表于 2014-9-13 11:31
当你不知如何实现一个复杂的计算时，建议采用：面向功能组合的编程方式来解决。
1， 先给自己定一个起点， ...

刚看到，本以为能用多重循环或数组能高效的解决，所以没有将问题拆分、连自己也说得不明不白，想得到高效的方法、谢谢！

liulang0808

2、然后再求出A列黄色范围的名称
怎么求出来啊？

ak47ok

liulang0808 发表于 2014-9-13 11:39
2、然后再求出A列黄色范围的名称
怎么求出来啊？

怪我自己考虑不周密、没有表述情况，黄色的名称是直接给出、不用代码来求出。谢谢！

lipton

举个例子：
以数据源N：V列的数据结构，做为起点
方式1 ，把所需的数据源放进类进行初步处理
类所需的功能
1 ，填充数据成员  = （内部成员私有）
2，记录每个名称的所在行数（内部成员私有）
3，类的主体计算函数，函数需要什么参数。（公有）

类模块的初步实现：

1. '数据源类，对应N：V列
   
2. Private dicRowIndex As Dictionary
   
3. Private vDataSource As Variant
   
4. 
   
5. Public Sub ClassInitialize(rng As Range)
   
6.     '初始化数据结构成员
   
7.     Dim i As Long
   
8.     Dim nRow As Long
   
9.     Dim sKey As String
   
10.     vDataSource = rng.Value '同一数据编码数组
    
11.     nRow = rng.Rows
    
12.     dicRowIndex.RemoveAll
    
13.     i = 1
    
14.     Do
    
15.         sKey = vdatadource(i, 2) '名称，对应N列
    
16.         If Not dicRowIndex.Exists(sKey) Then
    
17.             dicRowIndex.Add sKey, i '保存名称所在行数
    
18.         End If
    
19.         i = i + 1
    
20.     Loop While i <= nRow
    
21.    
    
22. End Sub
    
23. 
    
24. Public Function getDataPem(strPem As String, KeyPrm As String) As Variant
    
25.     'keypem名称值：对应N列
    
26.     'strPem 对应B1: I1
    
27.     '如果计算参数不足继续添加
    
28.    
    
29.     Dim v As String '计算结果
    
30.     If dicRowIndex.Exists(keypem) Then
    
31.         Select Case strPem
    
32.             Case "甲"
    
33.                
    
34.             Case "乙"
    
35.             
    
36.             Case "丙"
    
37.             
    
38.             Case "丁"
    
39.             
    
40.             Case "卯"
    
41.             
    
42.             Case "己"
    
43.             
    
44.             Case "庚"
    
45.             
    
46.             cese "辛"
    
47.         End Select
    
48.     Else
    
49.         v = ""
    
50.     End If
    
51.     getDataPem = v
    
52.    
    
53. End Function
    
54. 
    
55. Private Sub Class_Initialize()
    
56.     Set dic = New Dictionary
    
57. End Sub
    
58. 
    
59. Private Sub Class_Terminate()
    
60.     Set dic = Nothing
    
61. End Sub

复制代码

入口模块的初步实现：

1. Private Sub main()
   
2.     Dim rngSource As Range
   
3.     Dim cSource As clsDataSource
   
4.    
   
5.     Set cSource = New clsDataSource
   
6.     cSource.ClassInitialize rngSource
   
7. 
   
8. End Sub

复制代码

lipton

有了起点后，可以开始完善主体函数，比如需要什么参数，计算细节的实现。
做完这一步开始下一步，如何得到一个Range 对象，细节，如何取得起始行数，如何取得列数，提取的条件等等。
注意“设计的过程不要写那些一句包含 完成多个功能的语句。

liulang0808

Sub 按钮1_Click()
    Application.ScreenUpdating = False
    Range("b10:i20").ClearContents
    Set Rng = Columns("m").Find(Cells(2, 1), lookat:=xlWhole, SearchDirection:=xlPrevious)
    If Rng Is Nothing Then MsgBox [a2] & ":该值在M列不存在": GoTo l1
    ru = Rng.Row
    Set Rng = Columns("m").Find(Cells(2, 1), lookat:=xlWhole, SearchDirection:=xlNext)
    rd = Rng.Row
    arr = Range("a10:i20")
    Set rng1 = Range("n" & rd & ":n" & ru)
    For j = 1 To UBound(arr)
        If Not rng1.Find(arr(j, 1), lookat:=xlWhole) Is Nothing Then
            r = rng1.Find(arr(j, 1), lookat:=xlWhole).Row
            For i = 2 To 9
                If InStr("丙辛", Cells(1, i)) > 0 Then
                    arr(j, i) = IIf(Cells(r, 14 + InStr("甲乙丙丁戊己庚辛", Cells(1, i))) >= Cells(2, i), 0, 1)
                Else
                    arr(j, i) = IIf(Cells(r, 14 + InStr("甲乙丙丁戊己庚辛", Cells(1, i))) > Cells(2, i), 1, 0)
                End If
            Next i
        End If
    Next j
     Range("a10:i20") = arr
l1:
    Application.ScreenUpdating = True
End Sub

liulang0808

运行结果跟你表内的数据有出入，核对下是否有问题吧