什么是将多个列合并为一个没有重复或空白的最有效方法？

Question

我有一个表，其中包含各种单元格中的条目，并希望将所有列合并为一个并删除任何空格或重复项。我已经开发了这段代码，但无法通过＆＃34; .Range（＆＃34; A100＆＃34;）。选择。＆＃34;有什么建议吗？

＆＃13;

＆＃13;

Private Sub CommandButton1_Click()

'Application.ScreenUpdating = False
Dim wb As Workbook
Dim wks2 As Worksheet, wks3 As Worksheet, wks5 As Worksheet
Dim cat As String, erow As Integer, lrow As Integer, i As Integer, j As Integer

Dim rr As Range, c As Collection, r As Range, L As Long

Set wb = ActiveWorkbook
Set wks2 = wb.Sheets(2)
Set wks3 = wb.Sheets(3)
Set wks5 = wb.Sheets(5)

'wks3.Activate

erow = wks3.Range("A" & Rows.Count).End(xlUp).Row  'Determines last row in the Cats-subCats sheet column A

'wks2.Activate

lrow = wks2.Range("I" & Rows.Count).End(xlUp).Row   'Determines last row in the DATA sheet column 9

For i = 2 To erow   'cycle through each category

    'wks3.Activate
    
    cat = wks3.Cells(i, 1)  'stores category name in variable cat
    
    'wks2.Activate
        
    For j = 2 To lrow 'cycle through each row of the DATA table

        If wks2.Cells(j, 9) = cat Then
        wks2.Cells(j, 20) = wks2.Cells(j, 10)    'temporarily stores the Weakness 1 values in column 20
        wks2.Cells(j, 21) = wks2.Cells(j, 11)    'temporarily stores the Weakness 2 values in column 21
        End If
        
    Next j
    
     MsgBox "pause"
      
      wks2.Range("T1:U2000").Copy Destination:=wks5.Range("A1")  'copies the temporary selection from sheet 2 and pastes in Sheet 5
      
   
    With wks5
               
    Set c = New Collection
   
    Set rr = Union(Intersect(Range("A:A"), ActiveSheet.UsedRange), Intersect(Range("B:B"), ActiveSheet.UsedRange))
    
    On Error Resume Next
    For Each r In rr
         If r.Value <> "" Then
            c.Add r.Value, CStr(r.Value)
        End If
    Next r
    On Error GoTo 0

    For L = 1 To c.Count
      Cells(L, "C").Value = c.Item(L)
    Next L
                
        
  End With
   
   
Next i


Application.CutCopyMode = False  'clear any thing on clipboard to maximize available memory

Application.ScreenUpdating = True

End Sub

＆＃13;

＆＃13;

＆＃13;

插入建议的代码，但在＆＃34;处获得运行时错误1004。设置rr = Union（相交（范围......＆＃34;行......还有其他任何建议？

Answer 1

怎么样：

Sub WhatEver()
   Dim rr As Range, c As Collection
   Dim L As Long
   Set c = New Collection
   Set rr = Union(Intersect(Range("A:A"), ActiveSheet.UsedRange), Intersect(Range("B:B"), ActiveSheet.UsedRange))

   On Error Resume Next
      For Each r In rr
         If r.Value <> "" Then
            c.Add r.Value, CStr(r.Value)
         End If
      Next r
   On Error GoTo 0

   For L = 1 To c.Count
      Cells(L, "C").Value = c.Item(L)
   Next L
End Sub