[已解决]请大神帮忙简化一下 现在一个按钮读取时间3分钟。。。

linif

请大神帮忙简化一下 现在一个按钮读取时间3分钟。。。奔溃了

最佳答案

月排行榜 / 总排行榜

grf1973

2015-5-20 16:33

但是上面的盘方查询，不是既要比较盘方，又要比较出资方吗？
至于下面明细里的空与非空，很容易实现。

跳转到最佳答案楼层

linif

怎么改举个例子谢谢

grf1973

改其中一部分，其他照着写吧。要学会用数组处理问题。

1. Sub 盘方查询()
   
2.     Application.ScreenUpdating = False
   
3.     Dim x, Sh As Worksheet, pf$, czf$, arr, brr
   
4.     x = 3
   
5.     With Sheets("录入登记表")
   
6.         brr = .[a1:m7]       '当前显示区域
   
7.         pf = brr(3, 3): czf = brr(3, 7)     '盘方、出资方
   
8.         If pf = "" And czf = "" Then
   
9.            .Cells(1, 10) = "请在操盘方姓名或出资方姓名选择要查询的客户"
   
10.            .Cells(1, 9) = "温馨→提示→"
    
11.            Exit Sub
    
12.         End If
    
13.         
    
14.         arr = Sheets("盘资方基本表").[a1].CurrentRegion    '数据源
    
15.         For x = 1 To UBound(arr)
    
16.             If arr(x, 2) = pf And arr(x, 13) = czf Then        '当当前区域的盘方、出资方和数据源的盘方、出资方相等
    
17.                 brr(3, 3) = arr(x, 2) '操盘方姓名
    
18.                 brr(3, 5) = arr(x, 3) '客户状态
    
19.                 brr(4, 3) = arr(x, 4) '联系方式
    
20.                 brr(4, 5) = arr(x, 5) '客户经理
    
21.                 brr(5, 3) = arr(x, 6) '应收月息利率
    
22.                 brr(5, 5) = arr(x, 7) '固定收息日期
    
23.                 brr(6, 3) = arr(x, 8) '本月应收利息
    
24.                 brr(6, 5) = arr(x, 9) '截止今日应收利息
    
25.                 brr(7, 3) = arr(x, 10) '保证金初始金额
    
26.                 brr(7, 5) = arr(x, 11) '保证金当前余额
    
27.                 brr(3, 7) = arr(x, 13) '出资方姓名
    
28.                 brr(3, 9) = arr(x, 14) '客户状态
    
29.                 brr(4, 7) = arr(x, 15) '联系方式
    
30.                 brr(4, 9) = arr(x, 16) '客户经理
    
31.                 brr(5, 7) = arr(x, 17) '支付月息利率
    
32.                 brr(5, 9) = arr(x, 18) '固定付息日期
    
33.                 brr(6, 7) = arr(x, 19) '本月应付利息
    
34.                 brr(6, 9) = arr(x, 20) '截止今日应付利息
    
35.                 brr(7, 7) = arr(x, 21) '初始出资金额
    
36.                 brr(7, 9) = arr(x, 22) '当前出资余额
    
37.                 brr(3, 11) = arr(x, 23) '证券公司账号
    
38.                 brr(4, 11) = arr(x, 24) '三方存管银行
    
39.                 brr(5, 11) = arr(x, 25) '利息支付银行
    
40.                 brr(1, 10) = "读取数据成功！"
    
41.                 Exit For
    
42.             End If
    
43.         Next
    
44.         .[a1:m7] = brr       '重写当前显示区域
    
45.     End With
    
46.     Application.ScreenUpdating = True
    
47. End Sub

复制代码

grf1973

再上一个，其他明细完全可以参照此例。

1. Sub 盘方利息明细读取()
   
2.     Application.ScreenUpdating = False
   
3.     Dim j, x, n, pf$, arr
   
4.     With Sheets("录入登记表")
   
5.         pf = .Cells(3, 3)     '盘方、出资方
   
6.         If pf = "" Then
   
7.            .Cells(1, 10) = "请在操盘方姓名或出资方姓名选择要查询的客户"
   
8.            .Cells(1, 9) = "温馨→提示→"
   
9.            Exit Sub
   
10.         End If
    
11.         
    
12.         arr = Sheets("盘方利息明细").[a1].CurrentRegion    '数据源
    
13.         Dim brr(1 To 100, 1 To 2)      '采集到的数据
    
14.         For x = 1 To UBound(arr)
    
15.             If arr(x, 2) = pf Then         '当当前区域的盘方和数据源的盘方相等
    
16.                 For j = 3 To UBound(arr, 2) Step 2
    
17.                     If Len(arr(x, j + 1)) > 0 Then
    
18.                         n = n + 1
    
19.                         brr(n, 1) = arr(x, j)
    
20.                         brr(n, 2) = arr(x, j + 1)
    
21.                     End If
    
22.                 Next
    
23.             End If
    
24.         Next
    
25.         If n > 0 Then .Cells(10, 2).Resize(n, 2) = brr
    
26.     End With
    
27.     Application.ScreenUpdating = False
    
28. End Sub

复制代码

grf1973

再进一步，所有的明细读取一个代码完成，用循环。

1. Sub 明细读取()
   
2.     Application.ScreenUpdating = False
   
3.     Dim j, x, n, pf$, czf$, arr, ShArray, xname, xx, brr, k
   
4.     ShArray = Array("盘方利息明细", "盘方补仓明细", "盘方取盈利明细", "盘方保证金明细", "资方利息明细", "资方出资金额明细")
   
5.     With Sheets("录入登记表")
   
6.         pf = .Cells(3, 3): czf = .Cells(3, 7)    '盘方、出资方
   
7.         If pf = "" Or czf = "" Then
   
8.            .Cells(1, 10) = "请在操盘方姓名或出资方姓名选择要查询的客户"
   
9.            .Cells(1, 9) = "温馨→提示→"
   
10.            Exit Sub
    
11.         End If
    
12.         
    
13.         For k = 0 To UBound(ShArray)
    
14.             xname = ShArray(k)
    
15.             xx = IIf(InStr(xname, "盘方") > 0, pf, czf)
    
16.             arr = Sheets(xname).[a1].CurrentRegion    '数据源
    
17.             n = 0
    
18.             ReDim brr(1 To 200, 1 To 2)      '采集到的数据
    
19.             For x = 1 To UBound(arr)
    
20.                 If arr(x, 2) = xx Then         '当当前区域的盘方和数据源的盘方相等
    
21.                     For j = 3 To UBound(arr, 2) Step 2
    
22.                         If Len(arr(x, j + 1)) > 0 Then
    
23.                             n = n + 1
    
24.                             brr(n, 1) = arr(x, j)
    
25.                             brr(n, 2) = arr(x, j + 1)
    
26.                         End If
    
27.                     Next
    
28.                 End If
    
29.             Next
    
30.             If n > 0 Then .Cells(10, 2 * (k + 1)).Resize(n, 2) = brr
    
31.         Next
    
32.     End With
    
33.     Application.ScreenUpdating = False
    
34. End Sub

复制代码

grf1973

当然数据录入也可以照此办理。反过来就行。

linif

grf1973 发表于 2015-5-20 10:39
当然数据录入也可以照此办理。反过来就行。

谢谢，读取的时候，资方利息明细，资方出资金额明细， 两个表读取不了。
查询是按 操盘方姓名或出 资方姓名 其中一个查询，我把里面的and 改成or貌似没有效果，你写的似乎要按操盘方和出资方同时查询。您太高深 有点看不懂 劳烦修改下。

grf1973

可以读取的呀。我的程序的意思是：如果表名含“盘方”，那么通过盘方姓名定位，否则通过出资方姓名定位。

grf1973

从清空开始，哪里不对了？

linif

grf1973 发表于 2015-5-20 15:57
从清空开始，哪里不对了？

就是可以按盘方姓名 也可以按资方姓名查，选择按盘方名字的时候查询 结果和按资方查询结果是一样的，
盘方姓名不为空 资方姓名为空时按盘方查询，相反按资方姓名查询，两者都为空 或都不为空时提示