求这个题目的另外一种简便算法（很有意思）

Question

题目是这样的！有个数值在不断增加中，
当这个数值小于10的时候，数值每增加1   变量A+1
当这个数值大于10且小于100的时候 数值每增加3 变量A+1
当这个数值大于100且小于1000的时候   每增加5 变量A+1
当这个........1000.....10000.....   每增加9 变量A+1
..............10000....100000....   每增加15 ...A+1
..............100000...1000000...   ......23 ...A+1
..............1000000..10000000..   ......33 ...A+1
..............10000000.100000000    ......45 ...A+1
这个数值增加到  X 的时候  变量A 的数值结果 （X=任意数）规律A：位数进1时候变化  
规律B：增加规律为2（5-3）到 4（9-5） 到6（15-9=6） 到8（23-15=8）....现在我使用的是最原始的方法解题，FOR 循环语句..但是FOR循环语句有个问题就是： 如果数值太大的话..程序需要比较长的时间才算出结果！ 现在求一种更为简便的方法（另外的算法）
==============
我目前的解决方案
程序包含2TEXT 1COMMAND
代码...........
Private Sub Command1_Click()
a = Val(Text1)
c = 0
For i = 1 To aIf i <= 10 Then b = b + 1If i > 10 And i <= 100 Then
    c = c + 1
    If c = 3 Then c = 0:  b = b + 1
End IfIf i > 100 And i <= 1000 Then
    c = c + 1
    If c = 5 Then c = 0:    b = b + 1
End IfIf i > 1000 And i <= 10000 Then
    c = c + 1
    If c = 9 Then c = 0:  b = b + 1
End IfIf i > 10000 And i <= 100000 Then
    c = c + 1
    If c = 15 Then c = 0:  b = b + 1
End IfIf i > 100000 And i <= 1000000 Then
    c = c + 1
    If c = 23 Then c = 0:  b = b + 1
End IfIf i > 1000000 And i <= 10000000 Then
    c = c + 1
    If c = 33 Then c = 0:   b = b + 1
End IfIf i > 10000000 And i <= 100000000 Then
    c = c + 1
    If c = 77 Then c = 0:  b = b + 1
End IfNext iText2 = Str(b)End Sub===============这个是比较笨得方法，大数的时候需要时间很长，不太理想，希望有人能想出更好的方案（代码格式不是很严格，请见谅）===================

Answer 1

区间和你要求的不一样，是[a,b)了。
自己再琢磨改下吧：
Private Sub Command1_Click() '1亿耗时40s左右
    Dim i&, Result&, s&
    Debug.Print Format(Now, "hh:mm:ss")
    For i = 1 To 100000000
        If i < 10 Then
            Result = Result + 1
        Else
            s = 2 ^ (Len(CStr(i)) - 1) + 1
            If i Mod s = 0 Then Result = Result + 1
        End If
        DoEvents
    Next
    Debug.Print Format(Now, "HH:mm:ss")
    Debug.Print Result
End Sub

Answer 2

感谢vbload的回复 求余的方法非常不错（乘方那步没搞懂！），学习了！ 不过不知是何问题，导致两段代码执行的结果不一致（数值越大偏差越大，小于等于号的问题？？）....
谁帮看看是什么回事？ 我现在的代码有错误了吗？

Answer 3

你总共就是8段，所以用8个FOR NEXT就可以了
FOR I=1 TO 10
NEXTFOR I=10 TO 100
NEXTFOR I=100 TO 1000
NEXT这种方法不会造成代码重复在浪费检测。如果你提问题的那种方法，里面有10个大于多少小于之少的检测的话，速度会慢10倍左右下来。

Answer 4

用你现在的方法，17秒左右完成。我CPU 2。6G双核
'〓〓〓〓〓〓〓〓〓〓WebPause函数相关定义声明等 Start
Private Declare Sub Sleep Lib "kernel32" (ByVal dwmilliseconds As Long)
Private Declare Function GetTickCount Lib "kernel32" () As Long
'〓〓〓〓〓〓〓〓〓〓WebPause函数相关定义声明等 End
'┏〓〓〓〓〓〓〓〓〓 WebPause,start 〓〓〓〓〓〓〓〓〓┓
'［简介］：
'暂停以平衡速度和缓冲
Function WebPause(HowLong As Long)
   '[mycode_id:543],edittime:2008-2-18 上午 11:06:05
       Dim tick As Long
       tick = GetTickCount()
       Do
       Sleep 1
       DoEvents
       Loop Until tick + HowLong < GetTickCount
End Function
'┗〓〓〓〓〓〓〓〓〓  WebPause,end  〓〓〓〓〓〓〓〓〓┛Private Sub Form_Load()
Text1 = 100000000
End SubPrivate Sub Command1_Click()
Dim T As Long
T = GetTickCount
Dim 结果值 As Long
Dim 最大值 As Long
Dim c As Integer
Dim i As Long
最大值 = Val(Text1)
c = 0
For i = 1 To 最大值
If i Mod 100000 = 0 Then Me.Caption = i: Me.Refresh
If i <= 10 Then 结果值 = 结果值 + 1If i > 10 And i <= 100 Then
  c = c + 1
  If c = 3 Then c = 0: 结果值 = 结果值 + 1
End IfIf i > 100 And i <= 1000 Then
  c = c + 1
  If c = 5 Then c = 0: 结果值 = 结果值 + 1
End IfIf i > 1000 And i <= 10000 Then
  c = c + 1
  If c = 9 Then c = 0: 结果值 = 结果值 + 1
End IfIf i > 10000 And i <= 100000 Then
  c = c + 1
  If c = 15 Then c = 0: 结果值 = 结果值 + 1
End IfIf i > 100000 And i <= 1000000 Then
  c = c + 1
  If c = 23 Then c = 0: 结果值 = 结果值 + 1
End IfIf i > 1000000 And i <= 10000000 Then
  c = c + 1
  If c = 33 Then c = 0: 结果值 = 结果值 + 1
End IfIf i > 10000000 And i <= 100000000 Then
  c = c + 1
  If c = 77 Then c = 0: 结果值 = 结果值 + 1
End IfNext iText2 = Str(结果值)
MsgBox "用时：" & (GetTickCount - T) / 1000 & "秒"
End Sub

Answer 5

数值到999的时候 两种计算的结果还是一样的  1000数值的时候就开始偏差了!越到后面偏差越大！说明一下这个题目的数值 是【累加】上去的比如说，某个网站的点击率，点了点了100下获得积分最早的10点击会得到 10积分
以下是我的计算结果
====================
9=9积分
10=10积分
11=10积分
12=10积分
13=11积分（从10开始点3次算1积分）
14=11积分
15=11积分
16=12积分
........94=38积分
95=38积分
96=38积分
97=39积分
98=39积分
99=39积分
100=40积分
101=40积分
102=40积分
103=40积分
104=40积分
105=41积分 （从100开始点5次算1积分）
==================
以下是 vbload 的计算结果
9=9积分
10=9积分   差异（10）
11=9积分   差异（10）
12=10积分  差异（10）
13=10积分  差异（11）
14=10积分  差异（11）
15=11积分  差异（11）
.........
97=38积分  
98=38积分
99=39积分  重点在这里（第39积分的累积只有1次）
100=40积分  
101=40积分
102=40积分
103=40积分
104=40积分
105=41积分    虽然105的时候 两边计算的结果都是一样...
===============
我现在在想办法寻求不经过循环的方式求解，不过很难，规律很多，（貌似与尾数和位数有关...） 希望更多人加入到这的讨论中来！

Answer 6

关于 xiaoyao961 说的 分8段的问题 可能答案会出错！详细见6楼 的那个重点..
 
减少检测量提高速度的方法十分不错！学习了！

Answer 7

Private Sub Command1_Click()
    Dim i As Long
    Dim mStep As Long
    Dim A As Long
    Dim X As Long
    
'    当这个数值小于10的时候，数值每增加1 变量A+1
'    当这个数值大于10且小于100的时候 数值每增加3 变量A+1
'    当这个数值大于100且小于1000的时候 每增加5 变量A+1
'    当这个........1000.....10000..... 每增加9 变量A+1
'    ..............10000....100000.... 每增加15 ...A+1
'    ..............100000...1000000... ......23 ...A+1
'    ..............1000000..10000000.. ......33 ...A+1
'    ..............10000000.100000000 ......45 ...A+1    mStep = 1
    i = 1
    X = 100000000
    
    Do
        Select Case i
        Case 11 To 100
            mStep = 3
        Case 101 To 1000
            mStep = 5
        Case 1001 To 10000
            mStep = 9
        Case 10001 To 100000
            mStep = 15
        Case 100001 To 1000000
            mStep = 23
        Case 1000001 To 10000000
            mStep = 33
        Case 10000001 To 100000000
            mStep = 45
            
        End Select
        i = i + mStep
        A = A + 1
    Loop While i <= X
    
    Print A
End Sub

Answer 8

0.031秒Private Sub Command2_Click()
Dim T As Long
'算出的结果是：  1487908
T = GetTickCount
Dim 结果值 As Long
Dim 最大值 As Long
Dim c As Integer
Dim i As Long
最大值 = Val(Text1)
c = 0
'13时，结果值＝１１
 
Dim 当前位置数字 As Long
For i = 1 To 10
    结果值 = 结果值 + 1
Next
当前位置数字 = i - 1 + 3
For i = 当前位置数字 To 100 Step 3
 结果值 = 结果值 + 1
Next当前位置数字 = i - 3 + 5
For i = 当前位置数字 To 1000 Step 5
结果值 = 结果值 + 1
Next当前位置数字 = i - 5 + 9
For i = 当前位置数字 To 10000 Step 9
结果值 = 结果值 + 1
Next当前位置数字 = i - 9 + 15
For i = 当前位置数字 To 100000 Step 15
结果值 = 结果值 + 1
Next当前位置数字 = i - 15 + 23
For i = 当前位置数字 To 1000000 Step 23
 结果值 = 结果值 + 1
Next当前位置数字 = i - 23 + 33
For i = 当前位置数字 To 10000000 Step 33
结果值 = 结果值 + 1
Next当前位置数字 = i - 33 + 77
For i = 当前位置数字 To 100000000 Step 77
 结果值 = 结果值 + 1
Next iText2 = Str(结果值)
MsgBox "用时：" & (GetTickCount - T) / 1000 & "秒"
End Sub

Answer 9

11楼的，0.266秒Private Sub Test2()
Dim t As Long
t = GetTickCount
  Dim i As Long
  Dim mStep As Long
  Dim A As Long
  Dim X As Long
    
' 当这个数值小于10的时候，数值每增加1 变量A+1
' 当这个数值大于10且小于100的时候 数值每增加3 变量A+1
' 当这个数值大于100且小于1000的时候 每增加5 变量A+1
' 当这个........1000.....10000..... 每增加9 变量A+1
' ..............10000....100000.... 每增加15 ...A+1
' ..............100000...1000000... ......23 ...A+1
' ..............1000000..10000000.. ......33 ...A+1
' ..............10000000.100000000 ......45 ...A+1  mStep = 1
  i = 1
  X = 100000000
    
  Do
  Select Case i
  Case 11 To 100
  mStep = 3
  Case 101 To 1000
  mStep = 5
  Case 1001 To 10000
  mStep = 9
  Case 10001 To 100000
  mStep = 15
  Case 100001 To 1000000
  mStep = 23
  Case 1000001 To 10000000
  mStep = 33
  Case 10000001 To 100000000
  mStep = 45
    
  End Select
  i = i + mStep
  A = A + 1
  Loop While i <= X
    
Text2 = Str(A)
MsgBox "用时：" & (GetTickCount - t) / 1000 & "秒"
End Sub

Answer 10

没必要弄那么复杂吧。把每个门槛的花点时间算出来，其他的就只要加除法的商取整了。
A---B---C10---10---3
100---40---5
1000---220---9
10000---1220---15
100000---7220---23
1000000---46350---33
10000000---319077---45
100000000---1487908---59
(X-A)÷C（取整）+B
即可。Private Sub Command2_Click()
a = Val(Text1)
Dim b(8)
Dim d(8)
b(0) = 1
b(1) = 10
b(2) = 40
b(3) = 220
b(4) = 1220
b(5) = 7220
b(6) = 46350
b(7) = 319077
b(8) = 1487908
d(0) = 1
d(1) = 3
d(2) = 5
d(3) = 9
d(4) = 15
d(5) = 23
d(6) = 33
d(7) = 45
d(8) = 59
c = Int(Str(Log(a) / Log(10)))
Text2.Text = b(c) + (a - 10 ^ (c)) \ d(c)
End Sub

Answer 11

应该不用每次增加1这样循环.
从1到10,这个区间A会增加10次
从10-100区间,A会增加(100-10)/3 =30次
从100-1000区间,A会增加(1000-100)/5=180次
从1000-10000区间,A会增加(10000-1000)/9=1000次
...
这样这个数增加到x,A要增加的次数,就取决于x这个数经历来多少个区间..最后的那个区间要单独计算.
这样,就要先算x是多少个10进制位,vb算法是int(log(x)/log(10)),x是两位,就先算上10次,然后在算后面每次增加3次会有多少个A增加...如果x是3位,A就是10次,加上33次,再算后面每次增加5用多少次...
就是要先算好每个区间(10^0-10^1,10^1-10^2,10^2-10^3...)这些区间A的增加次数,不过还是比较简单.自认为这个用时比以上的最少.以下算法:结果和lz算法相同(lz算法没有doevents,很不好,假死)Dim x As Long
Dim abc '增加量
Dim xyz '区间增加次数
Dim A As Long '结果
Dim xW As Long 'x的位数
Dim i As Integer
x = Text1.Text
A = 0
abc = Array(1, 3, 5, 9, 15, 23, 33, 45)  'array的第一个元素下标是0
xyz = Array(0, 10, 30, 180, 1000, 6000, 9 * 10 ^ 5 \ 23, 9 * 10 ^ 6 \ 33, 9 * 10 ^ 7 \ 45)
If x > 10 ^ 8 Then Exit Sub '超过10^8=100000000就退出计算过程xW = Int(Log(x) / Log(10))
For i = 1 To xW
    A = A + xyz(i)
Next i
If xW = 0 Then x = x Else x = x - 10 ^ xW
A = A + x \ abc(xW)
Text2.Text = A

Answer 12

0秒Private Sub Command2_Click()
Dim t As Long
'算出的结果是：  1487908
t = GetTickCount
Dim 结果值 As Long
Dim 最大值 As Long
Dim c As Integer
Dim i As Long
最大值 = Val(Text1)
c = 0
'13时，结果值＝１１
 
Dim 当前位置数字 As Long
Dim 余数 As Integer
'For i = 1 To 10
结果值 = 10结果值 = 结果值 + Int((100 - 10) / 3)
余数 = 100 Mod 3结果值 = 结果值 + Int((1000 - 100 + 余数) / 5)
余数 = 100 Mod 5结果值 = 结果值 + Int((10000 - 1000 + 余数) / 9)
余数 = 1000 Mod 9结果值 = 结果值 + Int((100000 - 10000 + 余数) / 15)
余数 = 10000 Mod 15结果值 = 结果值 + Int((1000000 - 100000 + 余数) / 23)
余数 = 100000 Mod 23结果值 = 结果值 + Int((10000000 - 1000000 + 余数) / 33)
余数 = 1000000 Mod 33结果值 = 结果值 + Int((100000000 - 10000000 + 余数) / 77)
余数 = 10000000 Mod 77Text2 = Str(结果值)
MsgBox "用时：" & (GetTickCount - t) / 1000 & "秒"
End Sub

Answer 13

Dim c As Integer
Dim i As Long
最大值 = Val(Text1)
c = 0
'13时，结果值＝１１
 
Dim 当前位置数字 As Long
Dim 余数 As Integer
Dim D(7) As Integer
D(0) = 1
D(1) = 3
D(2) = 5
D(3) = 9
D(4) = 15
D(5) = 23
D(6) = 33
D(7) = 77Dim V
V = Array(0, 10, 100, 1000, 10000, 100000, 1000000, 10000000, 100000000)
For i = 0 To 7
结果值 = 结果值 + Int((V(i + 1) - V(i)) / D(i))
余数 = V(i + 1) Mod D(i)
NextText2 = Str(结果值)
MsgBox "用时：" & (GetTickCount - t) / 1000 & "秒"
End Sub

Answer 14

Private Sub Command2_Click()
Dim t As Long
'算出的结果是：   2319077
t = GetTickCount
Dim 结果值 As Long
Dim 最大值 As Long
Dim c As Integer
Dim i As Long
最大值 = Val(Text1)
c = 0
'13时，结果值＝１１
 
Dim 当前位置数字 As Long
Dim 余数 As Integer
Dim D(7) As Integer
D(0) = 1
D(1) = 3
D(2) = 5
D(3) = 9
D(4) = 15
D(5) = 23
D(6) = 33
D(7) = 45Dim V
V = Array(0, 10, 100, 1000, 10000, 100000, 1000000, 10000000, 100000000)
For i = 0 To 7
结果值 = 结果值 + Int((V(i + 1) - V(i)) / D(i))
余数 = V(i + 1) Mod D(i)
NextText2 = Str(结果值)
MsgBox "用时：" & (GetTickCount - t) / 1000 & "秒"
End Sub

Answer 15

Private Sub Command2_Click()
Dim t As Long
'算出的结果是：   2319077
t = GetTickCount
Dim 结果值 As Long
Dim 最大值 As Long
Dim c As Integer
Dim i As Long
最大值 = Val(Text1)
c = 0
'13时，结果值＝１１
 
Dim 当前位置数字 As Long
Dim 余数 As Integer
Dim D(7) As Integer
D(0) = 1
D(1) = 3
D(2) = 5
D(3) = 9
D(4) = 15
D(5) = 23
D(6) = 33
D(7) = 45Dim V
V = Array(0, 10, 100, 1000, 10000, 100000, 1000000, 10000000, 100000000)
For i = 0 To 7
结果值 = 结果值 + Int((V(i + 1) - V(i)) / D(i))
余数 = V(i + 1) Mod D(i)
NextText2 = Str(结果值)
MsgBox "用时：" & (GetTickCount - t) / 1000 & "秒"
End Sub

Answer 16

嗯 嗯 15楼的这种方法太好了 基本上秒杀！ 事先算好的这种方法真的很不错！ 学习 学习！ 感谢spt_petrolor提供的先进方案！

Answer 17

14楼的结果对吗？Private Sub Command2_Click()
a = Val(Text1)
Dim b(8)
Dim d(8)
b(0) = 1
b(1) = 10
b(2) = 40
b(3) = 220
b(4) = 1220
b(5) = 7220
b(6) = 46350
b(7) = 319077
b(8) = 1487908
d(0) = 1
d(1) = 3
d(2) = 5
d(3) = 9
d(4) = 15
d(5) = 23
d(6) = 33
d(7) = 45
d(8) = 59
c = Int(Str(Log(a) / Log(10)))
Text2.Text = b(c) + (a - 10 ^ (c)) \ d(c)
End Sub

Answer 18

奇怪！ 刚才貌似一直都没看到14L的代码！  1亿的结果是2319077 这个数应该是正确的！关于15楼的...  代码，仍然在啃！ 貌似啃不动~ 重要是不明白   int(log(x)/log(10))是什么含义（这个函数从来没用过！我是VB的爱好者，没有系统的学过东西！）不过15楼的思路我是明白了！

Answer 19

这个支持直接输入不同数字取得结果Private Sub Command2_Click()
Dim 输入数值 As Long
输入数值 = Val(Text1)
Dim 结果值 As Long
Dim 数值10的倍数 As Integer
Dim 间隔Sz, 区段值数值10的倍数 = (Log(输入数值) / Log(10))
间隔Sz = Array(1, 3, 5, 9, 15, 23, 33, 45)
区段值 = Array(10, 40, 220, 1220, 7220, 46350, 319077, 2319077)If 数值10的倍数 = 0 Then
    结果值 = 输入数值
ElseIf 输入数值 > 10 ^ 8 Then
    结果值 = -1
Else
    结果值 = 区段值(数值10的倍数 - 1)
    If 输入数值 - 10 ^ (数值10的倍数) > 0 Then
        结果值 = 结果值 + Int((输入数值 - 10 ^ (数值10的倍数)) / 间隔Sz(数值10的倍数))
    End If
End IfText2 = Str(结果值)
End Sub

Answer 20

Log(输入数值) / Log(10)，是说1亿=8，就是取出1亿是由几个10相乘，VB没直接这样的函数所以要这样转换一下Private Sub Form_Load()
MsgBox 开根号(125, 5)
End Sub
Function 开根号(值, 底数)
开根号 = Log(值) / Log(底数)
End Function有意这个意思，开根号(100, 10)=2

Answer 21

xiaoyao961 非常热心啊！ VB区有您这种人才 实在是幸运~ 修改的代码很不错~ 独特的中文变量~也让新手比较容易看懂代码~ 总之！ GOOD～　　xiaoyao961是好人　好人一生平安！

Answer 22

int(log(x)/log(10))获取到输入数的位数

Answer 23

一般用n次幂来表示。
例如：a的n次幂表示为a^n
      a的n次方根表示为a^(1/n) 
MsgBox 125 ^ (1 / 3)
值为5
对这个算法，还有什么办法，可以输入125和5，得到3？
就是说125=5^3,反过来算3咋算

Answer 24

获取到输入数的位数
不是可以使用 len（） 函数吗？刚好text中的是字串  最多加个 trim（） 去除前后空格就OK了 

Answer 25

Private Sub Command2_Click()
Dim 输入数值 As Long
输入数值 = Val(Text1)
Dim 结果值 As Long
Dim 数值10的倍数 As Integer
Dim 间隔Sz, 区段值数值10的倍数 = len(输入数值 & "")-1
'(Log(输入数值) / Log(10))
间隔Sz = Array(1, 3, 5, 9, 15, 23, 33, 45)
区段值 = Array(10, 40, 220, 1220, 7220, 46350, 319077, 2319077)If 数值10的倍数 = 0 Then
    结果值 = 输入数值
ElseIf 输入数值 > 10 ^ 8 Then
    结果值 = -1
Else
    结果值 = 区段值(数值10的倍数 - 1)
    If 输入数值 - 10 ^ (数值10的倍数) > 0 Then
        结果值 = 结果值 + Int((输入数值 - 10 ^ (数值10的倍数)) / 间隔Sz(数值10的倍数))
    End If
End IfText2 = Str(结果值)
End Sub