Excel VBA创build一个列表并添加唯一的条款

我试图从列A中取出string，只有在列B中不存在的情况下，才将它们移到列B.为此，我想列出一个列表并扫描列A中的所有列，但是，米不知道如何做到这一点在VBA。 在Python中，我记得使用的东西沿线

[If (x) not in (List)] 

但是同样的方法在Excel中并不适合我。

目前，我有以下几点

 Sub GatherAll() GL = List() rwcnt = WorksheetFunction.CountA(Range("A:A")) lastc = Cells(1, Columns.Count).End(xlToLeft).Column Dim i As Long For i = 2 To rwcnt Cells(i, 1).Value = n 

我想说一些像

 if n not in GL, GL.append(n) continue 

End Sub

如果有人能帮助我，我会很感激。

Answer 1

尝试调整下面的代码，以确切的需要，看看是否有帮助。 如果您需要帮助，请告诉我们。

 Sub MoveUniqueEntries() Dim oDict As Object Dim rToMove As Range Dim rDest As Range Dim rLoop As Range Set oDict = CreateObject("Scripting.Dictionary") Set rToMove = Intersect(Sheet1.Range("A1").CurrentRegion, Sheet1.Columns(1)) Set rDest = Sheet1.Range("B1") For Each rLoop In rToMove If oDict.exists(rLoop.Value) Then 'Do nothing Else oDict.Add rLoop.Value, 0 rDest.Value = rLoop.Value Set rDest = rDest.Offset(1) End If Next rLoop End Sub 

Answer 2

在您的VBA IDE中，您将不得不添加一个参考。 在工具下拉菜单中select参考。 然后select“Microsoft ActiveX Data Objects 2.8 Library”。

 Dim rs As New ADODB.Recordset Dim ws As Excel.Worksheet Dim lRow As Long Set ws = Application.ActiveSheet 'Add fields to your recordset for storing data. You can store sums here. With rs .Fields.Append "Row", adInteger .Fields.Append "Value", adInteger .Open End With lRow = 1 'Loop through and record what is in the first column Do While lRow <= ws.UsedRange.Rows.count rs.AddNew rs.Fields("Row").Value = lRow rs.Fields("Value").Value = ws.Range("A" & lRow).Value rs.Update lRow = lRow + 1 ws.Range("A" & lRow).Activate Loop 'Now go through and list out the unique values in columnB. lRow = 1 rs.Sort = "value" Do While lRow <= ws.UsedRange.Rows.count if rs.Fields("value").Value <> strLast then ws.Range("B" & lRow).Value = rs.Fields("value").Value lRow = lRow + 1 End if strLast = rs.Fields("value").Value Loop 

Answer 3

跨平台版本（但是对于大量的值将会很慢）：

 Sub UniquesTester() Dim v, u(), i As Long, n As Long n = 0 v = Range(Range("A1"), Cells(Rows.Count, 1).End(xlUp)).Value ReDim u(1 To UBound(v, 1)) For i = 1 To UBound(v, 1) If IsError(Application.Match(v(i, 1), u, 0)) Then n = n + 1 u(n) = v(i, 1) End If Next i ReDim Preserve u(1 To n) Range("c1").Resize(n, 1).Value = Application.Transpose(u) End Sub