快速排除已知数,求算法

VisualBUG 2007-12-19 12:37:25
用循环,快速的在list控件中添加 1 - 6000
在添加过程中需要将含有相同数的排除掉.
例如:
dim i as integer
for i = 1 to 6000
list1.additem i
doevents
next i

'这里假设 i = 234 , 并已经添加进 list1 中去
'在以后的循环中如果遇到 243 , 324 , 342 , 423 , 432 则不予添加.(就是将包含这些数字的统统抛弃掉.)
'用代码如何实现?
'不想生成每个数的时候再用内循环嵌套重新检查list中的已存在数了.效率太低...
'求精炼实力型实例代码... 100分送上!
'谢谢!
...全文
281 41 打赏 收藏 转发到动态 举报
AI 作业
写回复
用AI写文章
41 条回复
切换为时间正序
请发表友善的回复…
发表回复
KiteGirl 2007-12-21
  • 打赏
  • 举报
回复
VB老鸟言之有理,VBH的算法确实太占空间了。还是改进一下标志法更好。
Tiger_Zhao 2007-12-21
  • 打赏
  • 举报
回复
这只是hash函数的差异,而且在有效hash值个数(928)不变的情况下增大映射的目标区间并不是一种可取的方式。
设法减小目标区间才应该是努力的方向。
vbman2003 2007-12-21
  • 打赏
  • 举报
回复
感叹!小仙妹真是奇思妙想.....呵呵,学习!
KiteGirl 2007-12-21
  • 打赏
  • 举报
回复
改进了一下VBH算法的导出程序,速度明显改善:



Public Function fncVaEx() As String

Dim tSo As String
Dim tVos() As String

ReDim tVos(0 To 9765625)

Dim tVa() As Long

tVa() = fncVa()

Dim tVi As Long

For tVi = 0 To 6000

tVos(tVa(tVi)) = tVos(tVa(tVi)) & "," & tVi

Next

For tVi = 0 To 6000

If Not tVos(tVa(tVi)) = "" Then
tSo = tSo & tVos(tVa(tVi)) & vbCrLf
End If

tVos(tVa(tVi)) = ""

Next

fncVaEx = tSo
End Function
KiteGirl 2007-12-21
  • 打赏
  • 举报
回复
这是新算法,感觉它未必更好,但比较有趣。新算法原理如下:

对于数字2999,如果统计它的位直方图则是。

0 1 2 3 4 5 6 7 8 9
0 0 1 0 0 0 0 0 0 3

在6000以内的数字范围内,直方图的取值范围在0到4之间。可以用10位五进制来表达6000以内所有的直方图。这样就得到一个VBH值:

VBH=B9*5^9+B8*5^8+……+B0*5^0

2999的VBH值是5859400

如果两个值的VBH相同,则两个值包含同等种类、且每个种类数量相同的数字。

10位五进制的值取值范围在0到9765624之间,如果用标志法需占用40MB的内存,这是目前的计算机可以承受的。

以下是VBH算法,它可以求出928个结果,与上面dlyme和Tiger_Zhao的一样。



Private Sub Command1_Click()
Dim tList() As Long
'tList() = ValueListGet()
Text1.Text = fncVaEx() 'UBound(tList()) ' fncVaEx() 'tOutStr
End Sub

Private Sub Command2_Click()
Text1.Text = Fix(Log(9999) / Log(10))
End Sub

Public Function fncVaEx() As String

Dim tSo As String
Dim tVos() As String

ReDim tVos(0 To 9765625)

Dim tVa() As Long

tVa() = fncVa()

Dim tVi As Long

For tVi = 0 To 6000

tVos(tVa(tVi)) = tVos(tVa(tVi)) & "," & tVi

Next

For tVi = 0 To 9765625

If Not tVos(tVi) = "" Then

tSo = tSo & vbCrLf & tVos(tVi)

End If

Next

fncVaEx = tSo
End Function

Public Function fncVa()
Dim tVo() As Long

ReDim tVo(0 To 6000)

Dim tVt() As Long
Dim tVi As Long

'标记表

For tVi = 1 To 6000

tVo(tVi) = fncVBH(tVi)

Next

fncVa = tVo()
End Function

Private Function fncVBH(ByVal pV As Long) As Long 'Value Bit Histogram
Dim tVo As Long
Dim tBt(0 To 9) As Long

Dim tBi As Long
Dim tBv As Long
Dim tBc As Long

'求Bit直方图VBH。

tBc = Fix(Log(pV) / Log(10))

For tBi = 0 To tBc
tBv = (pV \ (10 ^ tBi)) Mod 10 'tBv=tBi位上的值(由于是10进制返回0-9之间的一个数字)
tBt(tBv) = tBt(tBv) + 1 '在tBv值对应的tBt表项上做标记。
Next

Dim tBm As Long

'以5进制压缩直方图

For tBi = 0 To 9
tVo = tVo + tBt(tBi) * 5 ^ tBi
Next

fncVBH = tVo
End Function

KiteGirl 2007-12-21
  • 打赏
  • 举报
回复
哈哈!我又想出一个新算法,稍后给你这个新算法。如果你看过该算法,你会觉得我上面那个算法实在太笨了。
Tiger_Zhao 2007-12-21
  • 打赏
  • 举报
回复
vbman2003用标志的方法应该是首选,我最初为了与dlyme的输出进行比较和校验而用了存值法,其实标志法最简洁,当然求hash值应该用KiteGirl的操着方式性能更好一点。
KiteGirl在标志法的基础上达实现了分组输出的功能,非常不错。
KiteGirl 2007-12-21
  • 打赏
  • 举报
回复
我研究了一下,得到928个结果是把12、21与1002、1020以及102、201统统区分出来导致的。
我的算法里把12、21看成0012和0021。把102、201当做0102和0201。区别应该就在这里。

下面程序可以得到全部序列归类,可以根据这个序列分析。

Private Sub Command1_Click()
Text1.Text = fncVaEx()
End Sub

Public Function fncVaEx() As String

Dim tSo As String
Dim tVos() As String

ReDim tVos(0 To 6000)

Dim tVa() As Long

tVa() = fncVa()

Dim tVi As Long

For tVi = 0 To 6000

tVos(tVa(tVi)) = tVos(tVa(tVi)) & "," & tVi

Next

For tVi = 0 To 6000

If Not tVos(tVi) = "" Then

tSo = tSo & vbCrLf & tVos(tVi)

End If

Next

fncVaEx = tSo
End Function

Public Function fncVa()
Dim tVo() As Long

ReDim tVo(0 To 6000)

Dim tVt() As Long
Dim tVi As Long
Dim tVs As Long

Dim tSortValue As Long

'标记表

For tVi = 1 To 6000

tVs = fncVs(tVi) 'tVs=位排序后的tVi。
tVo(tVi) = tVs

Next

fncVa = tVo()
End Function

Public Function fncVs(ByVal pV As Long) As Long
'值排序函数
Dim tVo As Long

Dim tBt() As Long

ReDim tBt(0 To 9)

Dim tBi As Long
Dim tBv As Long

'在Bit取值表标记Bit值

For tBi = 0 To 3
tBv = (pV \ (10 ^ tBi)) Mod 10 'tBv=tBi位上的值(由于是10进制返回0-9之间的一个数字)
tBt(tBv) = tBt(tBv) + 1 '在tBv值对应的tBt表项上做标记。
Next

Dim tBm As Long

'根据Bit值表的标记顺序重组值(也就是实现了排序)

For tBi = 0 To 9
If CBool(tBt(tBi)) Then
For tBm = 1 To tBt(tBi)
tVo = tVo * 10 + tBi
Next
End If
Next

fncVs = tVo
End Function
vbman2003 2007-12-21
  • 打赏
  • 举报
回复
KiteGirl 的这个排序算法学习了
vbman2003 2007-12-21
  • 打赏
  • 举报
回复
下面这个结果和dlyme和Tiger_Zhao一样了928个,不过算法还要再推敲:



Private Function GetSortValue(ByVal mInput As Integer) As Integer

Dim i As Integer, j As Integer, k As Integer
Dim p(9) As Integer
Dim tmp As Integer
Dim s As String

j = Len(CStr(mInput))
For i = 1 To j
tmp = Mid(mInput, i, 1)
p(tmp) = p(tmp) + 1
Next i

For i = 9 To 0 Step -1
If p(i) > 0 Then
k = 0
While p(i) - k
s = s & i
k = k + 1
Wend
End If
Next i
GetSortValue = CInt(s)

End Function

Private Sub Command1_Click()
List1.Clear
Dim i As Integer
Dim b(1 To 9995) As Boolean
Dim tmp As Integer

For i = 1 To 6000
tmp = GetSortValue(i)
If Not b(tmp) Then
b(tmp) = Not b(tmp)
List1.AddItem i
End If
Next
Debug.Print List1.ListCount
End Sub

vbman2003 2007-12-21
  • 打赏
  • 举报
回复
感觉 dlyme和Tiger_Zhao 的结果好象更接近楼主的要求吧,而且效率不错
我那个是借鉴小仙妹的思路用了排序,但结果感觉有问题......
如果用排序法要得到dlyme那样的结果,那么应该用逆序。也就是比如所有 123、132、231、213、321......等等,全部看成321
VisualBUG 2007-12-21
  • 打赏
  • 举报
回复
vbMan 2003 的方法不错,相对简单更容易理解.
KiteGirl 的确有才,学到了新方法!
Tiger_Zhao 全程关注,提供的方法我得细嚼慢咽..
dlyme 的方法也好,但是相对来说太复杂了,谢谢!

有7年没怎么接触过vb了,嗯,是的,最少7年了.... 这是我的小号,主ID是: lstar
hand in hand , play up ~~
谢谢大家的帮助!
VisualBUG 2007-12-21
  • 打赏
  • 举报
回复
感谢各位的支持和热心的解答.问题已经解决.学习了...
这里网速很慢,下班后结贴...

谢谢!
KiteGirl 2007-12-21
  • 打赏
  • 举报
回复
下面是最新的改进代码,采用我第一种算法。得到928种类别。
这个程序涉及到一个谁先谁后的问题:
对于123、321、231这几个值,如果先遇到321,则排斥123和其他组合。如果先遇到123,则排斥321和其他组合。

仅仅靠排序后的序列不能解决这个问题。

以下程序实现了先后顺序的区别,原理是:遇到一个从未在表中出现的新类别后,将排序后的值指向第一个遇到的属于此类别的值。以后所有值指向到的不是排序后的值,而是排序后的值被替换掉的第一个对应值。

以下用随机序列测试这个新的程序。每当重新点了按键后,有些序列的MasterValue是不同的。

Private Sub Command1_Click()
Dim tI As Long

'产生1-6000随机序列(采用交换法(戏称为“跳蚤算法”的那个))

Dim tR As Long
Dim tV() As Long

ReDim tV(0 To 6000)

For tI = 1 To 6000
tV(tI) = tI
Next

Dim tT As Long

Randomize Timer

For tI = 1 To 6000
tR = Int(Rnd * 6000) + 1
tV(tT) = tV(tI): tV(tI) = tV(tR): tV(tR) = tV(tT)
Next

'对1-6000随机序列进行分类。

Dim tVt() As Long
Dim tVo() As Long

ReDim tVt(0 To 9999)
ReDim tVo(0)

For tI = 1 To 6000

fncVa tV(tI), tVt(), tVo()

Next

Text1.Text = UBound(tVo())

Dim tOs() As String
Dim tS As String

ReDim tOs(0 To 9999)

For tI = 1 To 6000
tOs(tVt(tI)) = tOs(tVt(tI)) & "," & tI
Next

tS = UBound(tVo())

For tI = 1 To 6000
If Not (tOs(tI)) = "" Then
tS = tS & vbCrLf & "MasterValue:" & tI & ";" & (tOs(tI))
End If
Next
Text1.Text = tS 'fncVs(10) 'tS
End Sub

Public Function fncVa(ByVal pV As Long, ByRef pVt() As Long, ByRef pVo() As Long) As Boolean
'添加pV

Dim tVs As Long
Dim tVoe As Long

tVs = fncVs(pV)

tBo = CBool(pVt(tVs))

If Not tBo Then '检测tVs是否有效。

'将tVs指向pV

pVt(tVs) = pV

'添加到序列

tVoe = UBound(pVo()) + 1

ReDim Preserve pVo(tVoe)

pVo(tVoe) = pV

End If

pVt(pV) = pVt(tVs)

fncVa = Not tBo

End Function

Public Function fncVs(ByVal pV As Long) As Long
'值排序函数
Dim tVo As Long

Dim tBt() As Long

ReDim tBt(0 To 9)

Dim tBi As Long
Dim tBv As Long
Dim tBc As Long

tBc = Fix(CDbl(Log(pV)) / CDbl(Log(10)))

For tBi = 0 To tBc
tBv = (pV \ (10 ^ tBi)) Mod 10
tBt(tBv) = tBt(tBv) + 1
Next

Dim tBm As Long

For tBi = 9 To 0 Step -1
If CBool(tBt(tBi)) Then
For tBm = 1 To tBt(tBi)
tVo = tVo * 10 + tBi
Next
End If
Next

fncVs = tVo
End Function

Tiger_Zhao 2007-12-20
  • 打赏
  • 举报
回复
与dlyme的输出结果相同,都是 928 个有效数值。编译成 exe 后速度可以提高 1 个数量级。
Option Explicit
Option Base 1

Const MAX_NUMBER As Long = 6000

Private aResult(MAX_NUMBER) As Long '直接定义最大容量避免使用 Redim
Private lCount As Long 'aResult 中的有效数的个数

Sub Main()
计时开始
Filter
计时结束

Check
SaveFile App.Path & "\NumberList.txt"

计时开始
FilterByDlyme
计时结束

Check
SaveFile App.Path & "\DlymeList.txt"
End Sub

'没有根据位数分段进行优化,所以 aResult 中的数值无序也可以检查
Function Check() As Boolean
Dim bResult As Boolean
Dim i As Long
Dim j As Long
Dim m As Long

bResult = True

For i = 2 To lCount
m = aResult(i)
For j = 1 To i - 1
If IsHaveSameDigits(m, aResult(j)) Then
bResult = False
End If
Next
Next

If bResult = True Then Debug.Print "全部通过。"

Check = bResult
End Function

Sub Filter()
Dim lHighPower As Long '最高位权值:1,10,100,1000...
Dim lHighDigit As Long '用于比较的高位数字
Dim lLowDigit As Long '用于比较的低位数字
Dim lDigitPower As Long '用于提取某位数值时的权值:...1000,100,10,1
Dim bIsOut As Boolean
Dim n As Long

Erase aResult
lCount = 0

lHighPower = 1
While lHighPower <= MAX_NUMBER '按位数的多少进行循环
For n = lHighPower To Min(lHighPower * 10 - 1, MAX_NUMBER) '对相同位数的数进行判断
bIsOut = False
lDigitPower = lHighPower

lHighDigit = GetDigit(n, lDigitPower) '取最高位
If lDigitPower > 0 Then 'i至少有两位
lLowDigit = GetDigit(n, lDigitPower) '取第二位
While (lLowDigit = 0) And (lDigitPower > 0) '过滤第二位开始的0
lLowDigit = GetDigit(n, lDigitPower)
Wend
If lLowDigit <> 0 Then '类似 6000 没有第二个非零位,不需过滤
If lHighDigit > lLowDigit Then '比较最高位和下个非零位
bIsOut = True
Else
Do While lDigitPower > 0 '逐个比较
lHighDigit = lLowDigit
lLowDigit = GetDigit(n, lDigitPower)

If lHighDigit > lLowDigit Then
bIsOut = True
Exit Do
End If
Loop
End If
End If
End If

If Not bIsOut Then
lCount = lCount + 1
aResult(lCount) = n
End If
Next

lHighPower = lHighPower * 10
Wend
Debug.Print "过滤结果:" & lCount & " 个有效数值。"
End Sub

Function GetDigit(ByVal n As Long, ByRef DigitPower As Long) As Long
GetDigit = (n \ DigitPower) Mod 10
DigitPower = DigitPower \ 10 '为取下一位数字做准备
End Function

Function GetDigit2(ByRef n As Long, ByVal DigitPower As Long) As Long
GetDigit2 = (n \ DigitPower) Mod 10
End Function

Function IsHaveSameDigits(ByVal m As Long, n As Long) As Boolean
Dim aStateOfM(0 To 9) As Byte '纪录 m 中与每个下标对应的数字出现的次数
Dim aStateOfN(0 To 9) As Byte '纪录 n 中与每个下标对应的数字出现的次数
Dim lDigitPower As Long
Dim i As Long

lDigitPower = 1
While (lDigitPower <= m) And (lDigitPower <= n)
i = GetDigit2(m, lDigitPower)
aStateOfM(i) = aStateOfM(i) + 1

i = GetDigit2(n, lDigitPower)
aStateOfN(i) = aStateOfN(i) + 1

lDigitPower = lDigitPower * 10
Wend

If (lDigitPower <= m) Or (lDigitPower <= n) Then 'm、n 位数不同
Exit Function 'Return False
Else
For i = 0 To 9
If aStateOfM(i) <> aStateOfN(i) Then Exit Function 'Return False
Next
End If

Debug.Print "数值 " & m & " 和 " & n & " 由相同的数字组成。"

IsHaveSameDigits = True
End Function

Sub SaveFile(ByVal FileName As String)
Dim hFile As Integer
Dim i As Long

hFile = FreeFile()
Open FileName For Output Access Write As #hFile
For i = 1 To lCount
Write #hFile, aResult(i)
Next
Close #hFile
End Sub


'13楼的过滤方式
Sub FilterByDlyme()
Dim str As String
Dim flag As Boolean
Dim i As Long
Dim first As Long
Dim second As Long

Erase aResult
lCount = 0

For i = 1 To MAX_NUMBER
str = CStr(i)
flag = True
first = 1
second = 2
While flag And second <= Len(str)
If Mid(str, second, 1) = "0" Then
If first > 1 Then
If Asc(Mid(str, first, 1)) > Asc(Mid(str, second, 1)) Then
flag = False
End If
Else
second = second + 1
End If
Else
If Asc(Mid(str, first, 1)) > Asc(Mid(str, second, 1)) Then
flag = False
Else
first = second
second = second + 1
End If
End If
Wend
If flag Then
lCount = lCount + 1
aResult(lCount) = i
End If
Next

Debug.Print "Dlyme的过滤结果:" & lCount & " 个有效数值。"
End Sub
KiteGirl 2007-12-20
  • 打赏
  • 举报
回复
上面的fncVc的算法里,tVt表记录的排序后的元素与其“相仿”的值的数量。通过对应值在tVt表的位置是否大于0来判断该值是否该被排除。

以下是新算法。fncVa返回一个0 to 6000的表,表的每个元素记录的是他们排序后的值。通过判断值在fncVa表里对应值是否等于该值。如果不等则说明该值应该被排除。

下列测试程序返回的结果非常有趣:它返回的是依照每个序列被归类到一起的所有1到6000之间的值。

实际使用当中,还有一种情况可能是:对于3456、4365、6345这三个值,假如第一次出现的是6345,则把6345作为唯一存在的而排斥掉其他的。如果你要这样做的话,应该用fncVa算法,而不是fncVc的算法。当然需要把fncVa改进一下——Va中元素指向的不再是排序后的值,而是排序后的Vs地址中所指向的值。
也就是说:fncVa算法中,4365按照排序规则本来应该指向3456,它并不读取3456中存储的是多少。但我们把这个算法改进一下,让4365在重定向时读一下3456,取3456对应的值。假如3456指向的值被定义为6345,所有指向3456的值都被指向6345。

Private Sub Command1_Click()
Dim tList() As Long
Text1.Text = fncVaEx()
End Sub


Public Function fncVaEx() As String

Dim tSo As String
Dim tVos() As String

ReDim tVos(0 To 6000)

Dim tVa() As Long

tVa() = fncVa()

Dim tVi As Long

For tVi = 0 To 6000

tVos(tVa(tVi)) = tVos(tVa(tVi)) & "," & tVi

Next

For tVi = 0 To 6000

If Not tVos(tVi) = "" Then

tSo = tSo & vbCrLf & tVos(tVi)

End If

Next

fncVaEx = tSo
End Function

Public Function fncVa()
Dim tVo() As Long

ReDim tVo(0 To 6000)

Dim tVt() As Long
Dim tVi As Long
Dim tVs As Long

Dim tSortValue As Long

'标记表

For tVi = 1 To 6000

tVs = fncVs(tVi) 'tVs=位排序后的tVi。
tVo(tVi) = tVs

Next

fncVa = tVo()
End Function

Public Function fncVs(ByVal pV As Long) As Long
'值排序函数
Dim tVo As Long

Dim tBt() As Long

ReDim tBt(0 To 9)

Dim tBi As Long
Dim tBv As Long

'在Bit取值表标记Bit值

For tBi = 0 To 3
tBv = (pV \ (10 ^ tBi)) Mod 10 'tBv=tBi位上的值(由于是10进制返回0-9之间的一个数字)
tBt(tBv) = tBt(tBv) + 1 '在tBv值对应的tBt表项上做标记。
Next

Dim tBm As Long

'根据Bit值表的标记顺序重组值(也就是实现了排序)

For tBi = 0 To 9
If CBool(tBt(tBi)) Then
For tBm = 1 To tBt(tBi)
tVo = tVo * 10 + tBi
Next
End If
Next

fncVs = tVo
End Function
KiteGirl 2007-12-20
  • 打赏
  • 举报
回复
以上是我提供给你的第一个算法。稍后我再给你个类似的算法,但思路与上述算法略有不同。这个新算法不仅能排除掉冲突的值,而且还能把每一种合法值的所有排列一一归类到一起。
KiteGirl 2007-12-20
  • 打赏
  • 举报
回复
为了便于你理解,我把我上述的程序以简化的方式提供给你。排序函数采用的是ValueSort2的写法。



Private Sub Command1_Click()
Dim tList() As Long
tList() = fncVc()
Dim tOutStr As String
For tIndex = 0 To UBound(tList())
tOutStr = tOutStr & "," & tList(tIndex)
If Not CBool(tIndex Mod 10) Then tOutStr = tOutStr & vbCrLf
Next
Text1.Text = tOutStr
End Sub

Public Function fncVc()
'返回1-6000所有不冲突的排列。
Dim tVo() As Long
Dim tVe As Long

Dim tVt() As Long
Dim tVi As Long
Dim tVs As Long

ReDim tVt(0 To 6000)

Dim tSortValue As Long

'标记表

For tVi = 1 To 6000

tVs = fncVs(tVi) 'tVs=位排序后的tVi。
tVt(tVs) = tVt(tVs) + 1 '在tVs对应的tVt()表对应位置进行标记。

Next

'从tVt中摘取被标记的元素到tVo。

For tVi = 1 To 6000

If CBool(tVt(tVi)) Then

ReDim Preserve tVo(tVe)

tVo(tVe) = tVi
tVe = tVe + 1

End If

Next

fncVc = tVo()
End Function

Public Function fncVs(ByVal pV As Long) As Long
'值排序函数
Dim tVo As Long

Dim tBt() As Long

ReDim tBt(0 To 9)

Dim tBi As Long
Dim tBv As Long

'在Bit取值表标记Bit值

For tBi = 0 To 3
tBv = (pV \ (10 ^ tBi)) Mod 10 'tBv=tBi位上的值(由于是10进制返回0-9之间的一个数字)
tBt(tBv) = tBt(tBv) + 1 '在tBv值对应的tBt表项上做标记。
Next

Dim tBm As Long

'根据Bit值表的标记顺序重组值(也就是实现了排序)

For tBi = 0 To 9
If CBool(tBt(tBi)) Then
For tBm = 1 To tBt(tBi)
tVo = tVo * 10 + tBi
Next
End If
Next

fncVs = tVo
End Function

vbman2003 2007-12-20
  • 打赏
  • 举报
回复
我晕,突然发现想过头了,改一下吧:

Private Function GetSortValue(ByVal mInput As Integer) As String

Dim i As Long, k As Integer
Dim b(9) As Integer
Dim tmp As Integer
Dim s As String

For i = 1 To Len(CStr(mInput))
tmp = Mid(mInput, i, 1)
b(tmp) = b(tmp) + 1
Next i

For i = 0 To 9
If b(i) > 0 Then
k = 0
While b(i) - k
s = s & i
k = k + 1
Wend
End If
Next i
GetSortValue = s

End Function

Private Sub Command1_Click()
Dim i As Integer
Dim b(1 To 6000) As Boolean
For i = 1 To 6000
If b(GetSortValue(i)) = False Then
b(GetSortValue(i)) = True
List1.AddItem i
End If
Next
End Sub



好象还是没前面几位快
vbman2003 2007-12-20
  • 打赏
  • 举报
回复
凑个热闹吧:


Option Explicit

Private Function GetSortValue(ByVal mInput As Integer) As String

Dim i As Long, k As Integer
Dim min As Integer, max As Integer
Dim b() As Integer
Dim tmp As Integer
Dim s As String

min = Left(mInput, 1)
max = min
For i = 1 To Len(CStr(mInput))
tmp = Mid(mInput, i, 1)
If tmp > max Then max = tmp
If tmp < min Then min = tmp
Next i

ReDim b(min To max)
For i = 1 To Len(CStr(mInput))
tmp = Mid(mInput, i, 1)
b(tmp) = b(tmp) + 1
Next i

For i = min To max
If b(i) > 0 Then
k = 0
While b(i) - k
s = s & i
k = k + 1
Wend
End If
Next i
GetSortValue = s

End Function

Private Sub Command1_Click()
Dim i As Integer
Dim b(1 To 6000) As Boolean
For i = 1 To 6000
If b(GetSortValue(i)) = False Then
b(GetSortValue(i)) = True
List1.AddItem i
End If
Next
Debug.Print List1.ListCount
End Sub




不知道是不是理解对了
加载更多回复(21)

7,785

社区成员

发帖
与我相关
我的任务
社区描述
VB 基础类
社区管理员
  • VB基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧