VB6 二维数组去重实现

关于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

 

转载于:https://www.cnblogs.com/lingqingxue/p/10505684.html