复制一个变量值并将其粘贴到另一个数据表上

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