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