If temp > Csum Then里增加了i = Left(i, j - 1) + 1 & String(Len(i) - j + 1, "1") - 1终于改善了速度,不加这句根本算不出来,直接卡死 Sub xxx() Csum = 11 n = 0 Dim jg() For i = 29 To 11111111115# i = Replace(i, 0, 1) temp = 0 For j = 1 To Len(i) If Mid(i, j, 1) = "0" Then Exit For temp = temp + Mid(i, j, 1) If temp > Csum Then i = Left(i, j - 1) + 1 & String(Len(i) - j + 1, "1") - 1 Exit For End If If temp = 11 And j = Len(i) Then ReDim Preserve jg(n) Debug.Print i jg(n) = i n = n + 1 End If Next Next End Sub
这个应该算是类似3楼的吧,用的递归,用时0.43-0.46秒的样子,跟5楼效率区别不大 Dim Count Sub yyy() t = Timer jg = xxx(11) Debug.Print Timer - t & "-" & Count End Sub Function xxx(n, Optional str = "") For i = 1 To IIf(n < 9, n, 9) If n = i Then xxx = str & i Debug.Print xxx Count = Count + 1 Exit Function Else tstr = str & i xxx n - i, tstr End If Next End Function