Excel精英培训网

 找回密码
 注册

QQ登录

只需一步,快速开始

你正在寻找更好的Excel学习教程吗?Excel技巧80集+数据透视表+函数初中高全套+VBA80集,想学的这儿全都有
查看: 148|回复: 5

[求助] 求优化或重写代码

[复制链接]
发表于 2019-4-25 18:05 | 显示全部楼层 |阅读模式
1学分
已有代码,但计算速度慢,求优化。

一、找出A10与C10相同的数组
二、找出A10与D10相同的数组
三、找出A10与E10相同的数组
四、找出A10与F10相同的数组
五、汇总C11-C14
六、去掉C15重复的数组
七、对C15数组从小到大排序
八、找出G10与C17不相同的数组

1.rar

37.09 KB, 下载次数: 7

发表于 2019-4-26 10:48 | 显示全部楼层
Sub 按钮1_Click()
Cells(1, 1) = Time
Dim fanZd As Object
Set fanZd = CreateObject("Scripting.Dictionary")
s1 = Cells(10, 1)
s2 = Cells(10, 3)
s3 = Cells(10, 4)
s4 = Cells(10, 5)
s5 = Cells(10, 6)
ss1 = ""
ss2 = ""
ss3 = ""
ss4 = ""
hj1 = 0
For i = 1 To 50000
    If (i - 1) * 5 + 1 < Len(s1) Then
       s = Mid(s1, (i - 1) * 5 + 1, 4)
       If InStr(s2, s) > 0 Then
          ss1 = ss1 & " " & s
          hj1 = hj1 + CInt(s)
          fanZd(s) = i
       End If
       If InStr(s3, s) > 0 Then
          ss2 = ss2 & " " & s
          hj1 = hj1 + CInt(s)
          fanZd(s) = i
       End If
       If InStr(s4, s) > 0 Then
          ss3 = ss3 & " " & s
          hj1 = hj1 + CInt(s)
          fanZd(s) = i
       End If
       If InStr(s5, s) > 0 Then
          ss4 = ss4 & " " & s
          hj1 = hj1 + CInt(s)
          fanZd(s) = i
       End If
       If InStr(s2, s) > 0 Then
          ss1 = ss1 & " " & s
       End If
       If InStr(s2, s) > 0 Then
          ss1 = ss1 & " " & s
       End If
    Else
       Exit For
    End If
Next i

Cells(11, 3) = Trim(ss1)
Cells(12, 3) = Trim(ss2)
Cells(13, 3) = Trim(ss3)
Cells(14, 3) = Trim(ss4)
Cells(15, 3) = hj1

s = ""
Dim arr()
arr = fanZd.keys
For i = 1 To UBound(arr)
    s = s & " " & arr(i)
Next i
Cells(16, 3) = Trim(s)

s1 = Cells(10, 3)
s2 = Cells(17, 7)
ss = ""
For i = 1 To 50000
    If (i - 1) * 5 + 1 < Len(s1) Then
       s = Mid(s1, (i - 1) * 5 + 1, 4)
       If InStr(s2, s) = 0 Then
          ss = ss & " " & s
       End If
    Else
       Exit For
    End If
Next i

Cells(19, 3) = Trim(ss)
Cells(2, 1) = Time
Cells(3, 1) = Cells(2, 1) - Cells(1, 1)

End Sub

整个过程的运行时间只有1秒
回复

使用道具 举报

 楼主| 发表于 2019-4-26 21:16 | 显示全部楼层
hfwufanhf2006 发表于 2019-4-26 10:48
Sub 按钮1_Click()
Cells(1, 1) = Time
Dim fanZd As Object

谢谢,但是这代码得出的结果跟我的附件有以下几个地方不一致:

1、“找出A10与C10相同的数组”不一致。
2、“汇总C11-C14”不一致。
3、“对C15数组从小到大排序”无结果。
4、“找出G10与C17不相同的数组”不一致。

麻烦再修改一下,谢谢
回复

使用道具 举报

发表于 2019-4-28 10:46 | 显示全部楼层
lxchk0001 发表于 2019-4-26 21:16
谢谢,但是这代码得出的结果跟我的附件有以下几个地方不一致:

1、“找出A10与C10相同的数组”不一致 ...

我之前没看你的结果,确实没全部理解你的要求。我修改了代码,但仍有三个项目不一致,先贴代码,后面我再讲差异:
Sub 按钮1_Click()
Cells(1, 1) = Time
s1 = Cells(10, 1)
s2 = Cells(10, 3)
s3 = Cells(10, 4)
s4 = Cells(10, 5)
s5 = Cells(10, 6)
ss1 = ""
ss2 = ""
ss3 = ""
ss4 = ""
ss5 = ""

For i = 1 To 50000
    If (i - 1) * 5 + 1 < Len(s1) Then
       s = Mid(s1, (i - 1) * 5 + 1, 4)
       If InStr(s2, s) > 0 Then
          ss1 = ss1 & " " & s
          ss5 = ss5 & " " & s
       End If
       If InStr(s3, s) > 0 Then
          ss2 = ss2 & " " & s
          ss5 = ss5 & " " & s
       End If
       If InStr(s4, s) > 0 Then
          ss3 = ss3 & " " & s
          ss5 = ss5 & " " & s
       End If
       If InStr(s5, s) > 0 Then
          ss4 = ss4 & " " & s
          ss5 = ss5 & " " & s
       End If
    Else
       Exit For
    End If
Next i

Cells(11, 3) = Trim(ss1)
Cells(12, 3) = Trim(ss2)
Cells(13, 3) = Trim(ss3)
Cells(14, 3) = Trim(ss4)
Cells(15, 3) = Cells(11, 3) & " " & Cells(12, 3) & " " & Cells(13, 3) & " " & Cells(14, 3)

s1 = Cells(15, 3)
ss1 = ""
For i = 1 To 50000
    If (i - 1) * 5 + 1 < Len(s1) Then
       s = Mid(s1, (i - 1) * 5 + 1, 4)
       If InStr(ss1, s) = 0 Then
          ss1 = ss1 & " " & s
       End If
    Else
       Exit For
    End If
Next i

Cells(16, 3) = Trim(ss1)
Cells(17, 3) = Trim(ss1)

s1 = Cells(10, 3)
s2 = Cells(17, 3)
ss = ""
For i = 1 To 50000
    If (i - 1) * 5 + 1 < Len(s1) Then
       s = Mid(s1, (i - 1) * 5 + 1, 4)
       If InStr(s2, s) = 0 Then
          ss = ss & " " & s
       End If
    Else
       Exit For
    End If
Next i

Cells(19, 3) = Trim(ss)

Cells(2, 1) = Time
Cells(3, 1) = Cells(2, 1) - Cells(1, 1)
End Sub


1、前4个是相符的,你数据后面都多一个空格,删除空格后与我的数据相同;
2、“汇总C11-C14”这个意思我没搞懂,之前我以为是对其中的数组计数汇总,看你的结果我理解成把c11-c14这4个连接在一起,不管怎么弄都与你数据有很大区别;
3、c16应该是正确的,你的结果有错误,中间多个空格(是中间不是结尾),去掉这个空格后与我的结果相同;
4、c17的“对C15数组从小到大排序”这个结果很奇怪,我的结果与你的结果(要去掉你中间多余的空格)长度相同,都是13839,但比较的结果不同,我也不知道差异在哪里?你可能需要仔细逐一比较才能看出差别来;
5、最后c19的差异也很奇怪,我不能肯定你是否正确。我仔细看了你的要求:找出G10与C17不相同的数组,是G10与C17的不同数组,而不是C17与G10的不同数组,这两个有可能会得到不同的结果的。

回复

使用道具 举报

发表于 2019-5-1 14:44 | 显示全部楼层
可能技术不怎么好,也得要 18秒才能完成!

什么.rar

77.81 KB, 下载次数: 0

回复

使用道具 举报

发表于 2019-5-17 10:00 | 显示全部楼层
  1. Function jiaoji$(a, b)
  2. Dim arr(9999) As Boolean, arr1, i&, s$
  3. a = Trim(a): b = Trim(b)
  4. arr1 = Split(a, " ")
  5. For i = 0 To UBound(arr1)
  6.   arr(arr1(i)) = True
  7. Next i
  8. arr1 = Split(b, " ")
  9. For i = 0 To UBound(arr1)
  10.   If arr(arr1(i)) = True Then s = s & " " & arr1(i)
  11. Next i
  12. jiaoji = Mid(s, 2)
  13. End Function

  14. Function quchong$(a)
  15. Dim arr(9999) As Boolean, arr1, i&, s$
  16. a = Trim(a)
  17. arr1 = Split(a, " ")
  18. For i = 0 To UBound(arr1)
  19.   If arr(arr1(i)) = False Then
  20.     s = s & " " & arr1(i)
  21.     arr(arr1(i)) = True
  22.   End If
  23. Next i
  24. quchong = Mid(s, 2)
  25. End Function

  26. Function paixu$(a)
  27. Dim arr(9999) As Boolean, arr1, i&, s$
  28. a = Trim(a)
  29. arr1 = Split(a, " ")
  30. For i = 0 To UBound(arr1)
  31.   arr(arr1(i)) = True
  32. Next i
  33. For i = 0 To 9999
  34.   If arr(i) = True Then s = s & " " & Format(i, "0000")
  35. Next i
  36. paixu = Mid(s, 2)
  37. End Function

  38. Function bingji$(a, b)
  39. Dim arr(9999) As Byte, arr1, i&, s$
  40. a = Trim(a): b = Trim(b)
  41. arr1 = Split(a, " ")
  42. For i = 0 To UBound(arr1)
  43.   arr(arr1(i)) = arr(arr1(i)) + 1
  44. Next i
  45. arr1 = Split(b, " ")
  46. For i = 0 To UBound(arr1)
  47.   arr(arr1(i)) = arr(arr1(i)) + 1
  48. Next i
  49. For i = 0 To 9999
  50.   If arr(i) = 1 Then s = s & " " & Format(i, "0000")
  51. Next i
  52. bingji = Mid(s, 2)
  53. End Function
复制代码
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2019-5-22 08:59 , Processed in 0.109200 second(s), 6 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表