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

假设您的值在＆＃34;数据＆＃34;工作表：

列在＆＃34; C＆＃34;
从第1行开始，使用＆＃34;标题＆＃34;

然后你可以试试这段代码：

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
主页➤查找＆amp;选择➤常量
http://www.contextures.com/images/formatformulas04.png
将选区复制并粘贴到另一张
数据➤删除重复项 http://blog.contextures.com/wp-content/uploads/2009/12/removedups02.jpg

P.S。我使用here中的＃3：]

Answer 3

字典也很有用，特别是如果您计划更复杂的过滤或计算：

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

复制变量值并将其粘贴到另一个spreasheet

3 个答案: