複製一個變量值並將其粘貼到另一個數據表上

Question

我現在要做的是取一個範圍（讓我們說C：C），通過所有具有值的單元格並將它們粘貼到另一個電子表格中。我的目標是複製一個變量值（因爲我不知道C：C中有多少個值），並將其粘貼到另一個工作表上，這樣我就可以擁有一個包含所有值的新範圍（沒有重複的價值）。

如何編寫If語句（用於變量值）。

如果有人能幫助我，我會很感激。這是我這一點：

Sub Test_1() 
    ' Go through each cells in the range 
    Dim rg As Range 
    Dim copySheet As Worksheet 
    Dim pasteSheet As Worksheet 

    Set copySheet = Worksheets("Data") 
    Set pasteSheet = Worksheets("Data_storage") 

    For Each rg In Worksheets("Data").Range("C:C") 

     If rg.Value = "Client 1" Then 'Instead of "Client 1" should be a variable value because "Client 1" will be a repetead value in C:C 
      copySheet.Range("C2").Copy 'Starting the counter in C2 
      pasteSheet.cells(Row.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValue 

     End If 

    Next 

End Sub 

Answer 1

假設你的價值觀在 「數據」 工作表：從第1行

• 在列 「C」

• 開始，用「頭」

，那麼你可以試試這個代碼：

Option Explicit 

Sub Test_1() 
    Dim sourceRng As Range, pasteRng As Range, cell As Range 

    Set pasteRng = Worksheets("Data_storage").Range("A1") '<--| set the upper-left cell in "paste" sheet 

    With Worksheets("Data") '<--| reference "source" sheet 
     Set sourceRng = .Range("D1", .Cells(.Rows.Count, "C").End(xlUp)) '<--| set the "source" range to columns "C:D" from row 1 down to last non empty cell in column "C" 
    End With 

    With sourceRng '<--| reference "source" range 
     .Sort key1:=.Range("a1"), order1:=xlAscending, key2:=.Range("B1"), order2:=xlAscending, header:=xlYes '<--| sort it by its column 1 and then by its column 2 
     pasteRng.Resize(.Rows.Count).value = .Resize(, 1).value '<--| paste its column 1 values to "Paste" sheet column 1 
     pasteRng.CurrentRegion.RemoveDuplicates Columns:=Array(1) '<--| leave only unique values in "paste" range 
     Set pasteRng = pasteRng.Range(pasteRng.Offset(1), pasteRng.End(xlDown)) '<--| skip "paste" range header 
     For Each cell In pasteRng '<--| loop through unique values in "paste" range column 1 
      .AutoFilter field:=1, Criteria1:=cell.value '<--| filter "source" range column 1 with current unique value 
      .Offset(1, 1).Resize(.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible).Copy '<--| copy "source" range" column 2 filtered cells 
      cell.Offset(, 1).PasteSpecial Transpose:=True '<--| ... and paste/transpose them aside current unique value in "paste" range 
     Next cell 
     .Parent.AutoFilterMode = False '<--| .. show all rows back... 
    End With 
End Sub 

Answer 2

如果你不想對它們進行排序，你可以記錄的是這樣的一個宏：

• 選擇C列

• 首頁➤查找&選擇➤常量
  http://www.contextures.com/images/formatformulas04.png

• 將選擇內容複製並粘貼到其他工作表

• 數據➤刪除重複
  http://blog.contextures.com/wp-content/uploads/2009/12/removedups02.jpg

P.S.我用＃3從here：]

Answer 3

字典也可以是有用的，特別是如果你計劃更復雜的過濾或計算：在你原來的（C欄），你可能有重複的數據

Public Sub CopyUnique(rngSource As Range, rngDestinationFirst As Range) 
    If rngSource Is Nothing Or rngSource.Worksheet.UsedRange Is Nothing Then 
     Exit Sub 
    End If 
    Dim dctValues As Scripting.Dictionary: Set dctValues = New Scripting.Dictionary ' Requires Tools > References > Microsoft Scripting Runtime 
    Dim rngSourceUsed As Range: Set rngSourceUsed = Application.Intersect(rngSource, rngSource.Worksheet.UsedRange) 
    Dim varCell As Variant: For Each varCell In rngSourceUsed.Cells: Dim rngCell As Range: Set rngCell = varCell 
     If dctValues.Exists(rngCell.Value) = False Then 
      dctValues.Add varCell.Value, varCell.Value ' varCell.Formula may be also interesting depending on the business logic 
     End If 
    Next varCell 
    Dim varValues() As Variant: ReDim varValues(0 To dctValues.Count - 1, 0 To 0) 
    Dim i As Long: i = LBound(varValues, 1) 
    Dim varValue As Variant: For Each varValue In dctValues.Keys 
     varValues(i, 0) = varValue 
     i = i + 1 
    Next varValue 
    rngDestinationFirst.Resize(dctValues.Count, 1).Value = varValues 
End Sub 

Public Sub TestCopyUnique() 
    CopyUnique ActiveSheet.Range("C:C"), Workbooks.Add(xlWBATWorksheet).Worksheets(1).Range("A1") 
End Sub