首页 > 编程语言 > 详细

VB6 二维数组去重实现

时间:2019-03-10 16:37:03      阅读:212      评论:0      收藏:0      [点我收藏+]

关于VB6的二维数组去重算法实现

当然,这里还是有局限性,当我们的数组被填满了各个不同的值时,例如下方 700*700 = 490000 就要While49万次,这谁受得了?

所以以下仅适合小规模使用 千次计算量以内可以考虑:

//InkHin_190310 // 求改进指导。

Option Explicit

Public Function C_StringValue(ByRef Value() As String, ByRef rValue() As Long)
ReDim Value(0 To 699, 0 To 699) As String
Dim y As Integer, x As Integer
For y = 0 To 699
For x = 0 To 699
    Value(x, y) = CStr(rValue(x, y))
Next
Next
Value 初始化默认值 = 0
Value(0, 300) = "100765"
Value(1, 0) = "999"
Value(10, 100) = "990001"
Value(100, 200) = "765990001"
Value(500, 200) = "1765990001"
Value(400, 200) = "22222"
Value(500, 100) = "7555555"
End Function

Public Function C_classification(ByRef rValue() As Long, ByRef Classification() As Long) As Long

Dim y As Integer, x As Integer, i As Long, i2 As Integer
//
Dim y2 As Integer, x2 As Integer, C As Boolean
Dim Classification() as Long
Dim Value() As String
ReDim rValue(0 To 699, 0 To 699)
Call C_StringValue(Value(), rValue()) to String

ReDim Classification(0) As Long
y2 = 0: x2 = 0: i2 = 0: C = True


Classification(0) = Value(0, 0)
While C
For i = i2 To UBound(Classification())
    C = False
For y = 0 To 699
For x = 0 To 699
    If Value(x, y) <> "" Then  a==b
        If Value(x, y) = CStr(Classification(i)) Then
        Value(x, y) = ""
        Else
            If Not C Then
                y2 = y
                x2 = x
                i2 = i2 + 1 i++
                C = True
            End If
        End If
    End If
Next
Next
If C Then
ReDim Preserve Classification(UBound(Classification()) + 1) As Long
Classification(UBound(Classification())) = Value(x2, y2)
End If
Next
Wend
For i = 0 To UBound(Classification())
MsgBox "位置:【" & CStr(i) & "】    :" & Classification(i)
Next
C_classification = UBound(Classification()) + 1
MsgBox "一共有:" & C_classification & "个值."
End Function

Private Sub Command1_Click()
Dim a_C() As Long, a() As Long
Call C_classification(a(), a_C())
End Sub

 

VB6 二维数组去重实现

原文:https://www.cnblogs.com/lingqingxue/p/10505684.html

(0)
(0)
   
举报
评论 一句话评论(0
关于我们 - 联系我们 - 留言反馈 - 联系我们:wmxa8@hotmail.com
© 2014 bubuko.com 版权所有
打开技术之扣,分享程序人生!