[原创]补充一些编程加速的小技巧

northwolves

to;northwolves

没发现和我说的哪一条相关吖？请不妨说清楚一些。

-----------------

许多资料建议If a > b Then c = True 写成 c = (a > b),我这样用了好几年了,一直以为后者更好些,去年才发现前者更快.

northwolves

空间换速度:

动态数组定义得大点,最后再去掉多余的部分,比直接累加上限要快得多

Sub test()
Dim i As Long, t As Single, d1() As String, d2() As String, k As Long
t = Timer

For i = 1 To 100000
ReDim Preserve d1(1 To i)
d1(i) = Date
Next i
time1 = Timer - t & " seconds"

t = Timer
ReDim Preserve d2(1 To 200000)
For i = 1 To 100000
d2(i) = Date
Next
ReDim Preserve d2(1 To 100000)
time2 = Timer - t & " seconds"
MsgBox time1 & vbCrLf & time2
End Sub

上述代码前者比后者费时近3倍

mingjl

谢谢！！受益匪浅

northwolves

穷举是计算机强项,也是解决许多问题的常用方法.但适当地前期处理可以大大减少计算量,从而几何级提速.列举一个九宫图的代码:

Sub test()

Dim i1 As Integer
Dim i2 As Integer
Dim i3 As Integer
Dim i4 As Integer
Dim i5 As Integer
Dim i6 As Integer
Dim i7 As Integer
Dim i8 As Integer
Dim i9 As Integer
Dim strTmp As String
Dim t(1 To 9) As String
'2 9 4
'7 5 3
'6 1 8
For i1 = 1 To 9
t(1) = i1
strTmp = "0" & i1
For i2 = 1 To 9
strTmp = "0" & i1
If InStr(1, strTmp, i2) = 0 Then
t(2) = i2
strTmp = "0" & i1 & i2
For i3 = 1 To 9
strTmp = "0" & i1 & i2
If InStr(1, strTmp, i3) = 0 Then
t(3) = i3
strTmp = "0" & i1 & i2 & i3
For i4 = 1 To 9
strTmp = "0" & i1 & i2 & i3
If InStr(1, strTmp, i4) = 0 Then
t(4) = i4
strTmp = "0" & i1 & i2 & i3 & i4
For i5 = 1 To 9
strTmp = "0" & i1 & i2 & i3 & i4
If InStr(1, strTmp, i5) = 0 Then
t(5) = i5
strTmp = "0" & i1 & i2 & i3 & i4 & i5
For i6 = 1 To 9
strTmp = "0" & i1 & i2 & i3 & i4 & i5
If InStr(1, strTmp, i6) = 0 Then
t(6) = i6
strTmp = "0" & i1 & i2 & i3 & i4 & i5 & i6
For i7 = 1 To 9
strTmp = "0" & i1 & i2 & i3 & i4 & i5 & i6
If InStr(1, strTmp, i7) = 0 Then
t(7) = i7
strTmp = "0" & i1 & i2 & i3 & i4 & i5 & i6 & i7
For i8 = 1 To 9
strTmp = "0" & i1 & i2 & i3 & i4 & i5 & i6 & i7
If InStr(1, strTmp, i8) = 0 Then
t(8) = i8
strTmp = "0" & i1 & i2 & i3 & i4 & i5 & i6 & i7 & i8
For i9 = 1 To 9
strTmp = "0" & i1 & i2 & i3 & i4 & i5 & i6 & i7 & i8
If InStr(1, strTmp, i9) = 0 Then
t(9) = i9
If t(1) + t(2) + t(3) = 15 Then
If t(1) + t(4) + t(7) = 15 Then
If t(2) + t(5) + t(8) = 15 Then
If t(3) + t(6) + t(9) = 15 Then
If t(4) + t(5) + t(6) = 15 Then
If t(7) + t(8) + t(9) = 15 Then
If t(1) + t(5) + t(9) = 15 Then
If t(3) + t(5) + t(7) = 15 Then
Debug.Print Join(t, "")
Exit Sub
End If
End If
End If
End If
End If
End If
End If
End If
End If
DoEvents
Next i9
End If
Next i8
End If
Next i7
End If
Next i6
End If
Next i5
End If
Next i4
End If
Next i3
End If
Next i2
Next i1

MsgBox "ok"

End Sub

晕不晕????????????????

先做适当的手工计算,优化后:

'易知九宫图中间为5，关于中心对称位置之和为10，分析如下：

' a b c

' d 5 10-d

' 10-c 10-b 10-a

'if a is an odd,c is an odd ,then 10-a is an odd,10-c is odd,so b,d,10-d,10-b are all odds(paradox)

'if a is an odd,c is an even ,then 10-a is an odd,10-c is even,so b,d,10-d,10-b are all evens(paradox)

'if a is an even,c is an odd ,then 10-a is an even,10-c is odd,so b,d,10-d,10-b are all evens(paradox)

'if a is an even,c is an even ,then 10-a is an even,10-c is even,so b,d,10-d,10-b are all odds(maybe)

'so a ,c must be evens; b,d must be odds

Sub test2()
Dim nine() As String
Dim a As Integer, b As Integer, c As Integer, d As Integer, i As Integer, k As Integer
For a = 2 To 8 Step 2
For b = 1 To 9 Step 2
For c = 2 To 8 Step 2
For d = 1 To 9 Step 2
If a + b + c = 15 And a + d - c = 5 And a + c <> 10 And b + d <> 10 And b <> 5 And d <> 5 Then
k = k + 1
ReDim Preserve nine(1 To k)
nine(k) = StrConv(a & b & c & vbCrLf & d & "5" & (10 - d) & vbCrLf & (10 - c) & (10 - b) & (10 - a), vbWide) '全角显示
End If
Next: Next: Next: Next
For i = 1 To k
Debug.Print "九宫图之" & i
Debug.Print nine(i)
Next
End Sub

northwolves

除非无奈,尽量不要做字符串的比较,甚至空字串,很费时

Sub test()
Const x As String = "abcdefghijklmn"
Dim y As Long, num As Long, i As Integer, j As Long

For i = 3 To 8
num = 10 ^ i

t = Timer
y = 0
For j = 1 To num
y = y + (x > " ")
Next
time1 = Timer - t & " seconds"

t = Timer
y = 0
For j = 1 To num
y = y + (Len(x) > 0)
Next
time2 = Timer - t & " seconds"
Debug.Print "num=" & num; vbTab; "(x > """") 用时: " & time1; vbTab; " (Len(x) > 0); 用时; " & time2; ""

Next
End Sub

随着循环次数加大,前者越来越慢

num=1000 (x > "") 用时: 0 seconds (Len(x) > 0); 用时; 0 seconds
num=10000 (x > "") 用时: 0 seconds (Len(x) > 0); 用时; 0 seconds
num=100000 (x > "") 用时: 0.015625 seconds (Len(x) > 0); 用时; 0 seconds
num=1000000 (x > "") 用时: 0.140625 seconds (Len(x) > 0); 用时; 0.046875 seconds
num=10000000 (x > "") 用时: 1.359375 seconds (Len(x) > 0); 用时; 0.546875 seconds
num=100000000 (x > "") 用时: 13.625 seconds (Len(x) > 0); 用时; 5.109375 seconds

northwolves

虽然许多资料建议少使用LIKE 函数,但本人发现它的速度还是远快于MID()

如判断字符串X的第5位是否为一个数字:

Sub test()
Const x As String = "ABCD1EFG"
Dim y As Long, num As Long, i As Integer, j As Long

For i = 1 To 9
num = i * 1000000

t = Timer
y = 0
For j = 1 To num
y = y + (x Like "????#*")
Next
time1 = Timer - t & " seconds"

t = Timer
y = 0
For j = 1 To num
y = y + (IsNumeric(Mid(x, 5, 1)))
Next
time2 = Timer - t & " seconds"
Debug.Print "num=" & num; vbTab; "(x Like ""????#*"") 用时: " & time1; vbTab; " (IsNumeric(Mid(x, 5, 1))); 用时; " & time2; ""

Next
End Sub

-------------------------------

返回:

num=1000000 (x Like "????#*") 用时: 0.15625 seconds (IsNumeric(Mid(x, 5, 1))); 用时; 0.953125 seconds
num=2000000 (x Like "????#*") 用时: 0.296875 seconds (IsNumeric(Mid(x, 5, 1))); 用时; 1.890625 seconds
num=3000000 (x Like "????#*") 用时: 0.453125 seconds (IsNumeric(Mid(x, 5, 1))); 用时; 2.859375 seconds
num=4000000 (x Like "????#*") 用时: 0.578125 seconds (IsNumeric(Mid(x, 5, 1))); 用时; 3.796875 seconds
num=5000000 (x Like "????#*") 用时: 0.734375 seconds (IsNumeric(Mid(x, 5, 1))); 用时; 4.71875 seconds
num=6000000 (x Like "????#*") 用时: 0.875 seconds (IsNumeric(Mid(x, 5, 1))); 用时; 5.703125 seconds
num=7000000 (x Like "????#*") 用时: 1.015625 seconds (IsNumeric(Mid(x, 5, 1))); 用时; 6.65625 seconds
num=8000000 (x Like "????#*") 用时: 1.171875 seconds (IsNumeric(Mid(x, 5, 1))); 用时; 7.640625 seconds
num=9000000 (x Like "????#*") 用时: 1.328125 seconds (IsNumeric(Mid(x, 5, 1))); 用时; 8.5625 seconds

UNARTHUR

to:northwolves

好长的贴！呵呵，这么多内容建议这位朋友可以另开一个贴子了。

另：对定义动态数组的那一条持保留意见。

northwolves

大数组的复制,可以使用API函数COPYMEMORY:

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Sub test()
Dim x(30000000) As Byte, y() As Byte, z() As Byte, i As Long, num As Long
For i = 0 To 30000000
x(i) = i Mod 256
Next
num = 100000

Do While num <= 30000000

ReDim y(num)
ReDim z(num)

t = Timer
For i = 0 To num
y(i) = x(i)
Next
time1 = Timer - t & " seconds"

t = Timer

CopyMemory z(0), x(0), num

time2 = Timer - t & " seconds"
Debug.Print "num=" & num; vbTab; "y(i) = x(i) 用时: " & time1; vbTab; " CopyMemory z(0), x(0), 100000000; 用时; " & time2; ""
num = num * 2
Loop

End Sub

num=100000 y(i) = x(i) 用时: 0.015625 seconds CopyMemory z(0), x(0), 100000000; 用时; 0 seconds
num=200000 y(i) = x(i) 用时: 0.03125 seconds CopyMemory z(0), x(0), 100000000; 用时; 0 seconds
num=400000 y(i) = x(i) 用时: 0.0625 seconds CopyMemory z(0), x(0), 100000000; 用时; 0 seconds
num=800000 y(i) = x(i) 用时: 0.140625 seconds CopyMemory z(0), x(0), 100000000; 用时; 0 seconds
num=1600000 y(i) = x(i) 用时: 0.28125 seconds CopyMemory z(0), x(0), 100000000; 用时; 0 seconds
num=3200000 y(i) = x(i) 用时: 0.546875 seconds CopyMemory z(0), x(0), 100000000; 用时; 0 seconds
num=6400000 y(i) = x(i) 用时: 1.109375 seconds CopyMemory z(0), x(0), 100000000; 用时; 0.015625 seconds
num=12800000 y(i) = x(i) 用时: 2.171875 seconds CopyMemory z(0), x(0), 100000000; 用时; 0.03125 seconds
num=25600000 y(i) = x(i) 用时: 4.390625 seconds CopyMemory z(0), x(0), 100000000; 用时; 0.046875 seconds

zw1028

还有吗？学生求知若渴！

qee用

数组复制,直接使用Variant类型数赋值即可.
Dim i%
Dim arr1%(100), arr2
For i = 1 To 100
arr1(i) = i
Next i
arr2 = arr1