恳请高手师傅们帮忙看下这个要咋删除相同

gwjkkkkk

利用内置功能还是最简单。。。

zhangcheng6688

学习一下
Sub test()
arr = [a2].CurrentRegion
ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
For i = 2 To UBound(arr)
   If arr(i, 2) <> "" Then
      m = m + 1
      For j = 1 To UBound(arr, 2)
         brr(m, j) = arr(i, j)
      Next
      For k = i + 1 To UBound(arr)
         If arr(k, 2) <> "" Then
            If arr(i, 2) = arr(k, 2) Then
               arr(k, 2) = vbNullString
            End If
         End If
       Next
    End If
Next
[a2].Resize(UBound(brr), UBound(brr, 2)) = brr
End Sub

zhangcheng6688

学习一下字典，哈
arr = [a1].CurrentRegion
ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
Set d = CreateObject("scripting.dictionary")
For i = 2 To UBound(arr)
   If Not d.exists(arr(i, 2)) Then
      m = m + 1
      d(arr(i, 2)) = ""
      For j = 1 To UBound(arr, 2)
         brr(m, j) = arr(i, j)
      Next
   End If
Next
[a1].CurrentRegion.Offset(1) = ""
[a2].Resize(m, UBound(brr, 2)) = brr