VB 二维数组中删除 相同元素 只保留一个

Question

Dim Array(,) As Integer = {{1, 1}, {1, 1}, {2, 2}, {3, 3}, {1, 1}}

答案为： {1, 1}, {2, 2}, {3, 3}

Answer 1

Option Explicit
Option Base 1
Private Sub Form_Load()
    Dim x(5, 2) As Integer, y() As Integer, z() As Integer
    x(1, 1) = 1
    x(1, 2) = 1
    x(2, 1) = 1
    x(2, 2) = 1
    x(3, 1) = 2
    x(3, 2) = 2
    x(4, 1) = 3
    x(4, 2) = 3
    x(5, 1) = 1
    x(5, 2) = 1
    
    Dim i As Long, j As Long, k As Long, l As Long
    ReDim y(1, UBound(x, 2)) As Integer
    For k = LBound(x, 2) To UBound(x, 2)
        y(1, k) = x(1, k)
    Next
    
    For i = LBound(x) + 1 To UBound(x)
        For j = LBound(y) To UBound(y)
            For k = LBound(x, 2) To UBound(x, 2)
                If y(j, k) <> x(i, k) Then
                    Exit For
                End If
            Next
            '有完全重复的元素
            If k > UBound(x, 2) Then
                Exit For
            End If
        Next
        '该元素是新的，没有重复的，添加到新数组
        If j > UBound(y) Then
            ReDim z(j, UBound(x, 2)) As Integer
            For k = LBound(y) To UBound(y)
                For l = LBound(x, 2) To UBound(x, 2)
                    z(k, l) = y(k, l)
                Next
            Next
            
            For k = LBound(x, 2) To UBound(x, 2)
                z(j, k) = x(i, k)
            Next
            
            ReDim y(j, UBound(x, 2)) As Integer
            For k = LBound(y) To UBound(y)
                For l = LBound(x, 2) To UBound(x, 2)
                    y(k, l) = z(k, l)
                Next
            Next
        End If
    Next
    
    Dim strMsg As String
    For i = LBound(y) To UBound(y)
        strMsg = y(i, 1)
        For k = 2 To UBound(x, 2)
            strMsg = strMsg & " " & y(i, k)
        Next
        MsgBox strMsg
    Next
End Sub

这个比较灵活，不限制你的数组的第一维和第二维的大小。

也就是说，Dim x(5, 2) As Integer可以用这个代码，dim x(500,200)也可以用这个代码。

Answer 2

程序如下，若满意请及时采纳，谢谢
Private Type POINT
X As Integer
Y As Integer
End Type

Dim a(100) As POINT, b(100) As POINT

Private Sub Command1_Click()
a(1).X = 1: a(1).Y = 1
a(2).X = 1: a(2).Y = 1
a(3).X = 2: a(3).Y = 2
a(4).X = 3: a(4).Y = 3
a(5).X = 1: a(5).Y = 1
p = 0
For i = 1 To 5
If i = 1 Then
p = p + 1
b(p) = a(i)
Else
t = 1
For j = 1 To p
If a(i).X = b(j).X And a(i).Y = b(j).Y Then t = 0: Exit For
Next j
If t = 1 Then p = p + 1: b(p) = a(i)
End If
Next i
For i = 1 To p
Print b(i).X, b(i).Y
Next i

End Sub本回答被提问者和网友采纳