Excel 从不同的列中获取唯一值并粘贴到另一个工作表中

我可以从一列（sheet1）中获取值，然后粘贴到另一列（sheet2）

我想做的不是只对一列执行一个操作，而是对多列（b，e，g）执行一个操作。我该怎么做呢？

试试这个：

Sub Test()
    Dim Sh1 As Worksheet
    Dim Rng As Range
    Dim Sh2 As Worksheet
    Dim Col As Long
    Set Sh1 = Worksheets("Sheet1")
    Set Sh2 = Worksheets("Sheet2")

    For Col = 1 To 3
        Set Rng = Sh1.Range(Sh1.Cells(1, Col), Sh1.Cells(65536, Col).End(xlUp))
        Rng.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sh2.Cells(1, Col), Unique:=True
    Next
End Sub

---

Col是列数的循环，每个列都会被复制以获得唯一的值。根据需要更改1和3（例如，B-F列将为2-6）。

您需要定义特定的列

ColumnList=Array（“B”、“e”、“g”）

，然后使用循环为ColumnList中的每个列处理它们

另外，我建议使用有意义的变量名，例如
wsInput
而不是
sh1
，这样可以使代码更易于人类阅读，从而更易于维护，从而减少错误

Option Explicit

Public Sub CopyUniqueDataOfColumns()
    Dim wsInput As Worksheet
    Set wsInput = ThisWorkbook.Worksheets("Sheet1")

    Dim wsOutput As Worksheet
    Set wsOutput = ThisWorkbook.Worksheets("Sheet2")

    Dim ColumnList() As Variant
    ColumnList = Array("B", "E", "G")

    Dim LastRow As Long
    Dim CopyRng As Range

    Dim Col As Variant
    For Each Col In ColumnList
        LastRow = wsInput.Cells(wsInput.Rows.Count, Col).End(xlUp).Row

        If LastRow > 1 Then 'If data is found copy it
            Set CopyRng = wsInput.Range(wsInput.Cells(1, Col), wsInput.Cells(LastRow, Col))
            CopyRng.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=wsOutput.Cells(1, Col), Unique:=True
        Else 'If no data copy only header
            wsOutput.Cells(1, Col).Value = wsInput.Cells(1, Col).Value
        End If
    Next Col
End Sub

只对连续列有效，但OP要求对B列有效，例如，不同Excel格式的行数超过
65536
始终使用
Sh1.rows.Count
。这会在CopyRng行上出现错误。AdvancedFilter操作：=xlFilterCopy，CopyToRange:=wsOutput.Cells（1，Col），Unique:=True非常感谢它的有效性。在
单元格（1，列）
中，调整行数以第2行开始。
Option Explicit

Public Sub CopyUniqueDataOfColumns()
    Dim wsInput As Worksheet
    Set wsInput = ThisWorkbook.Worksheets("Sheet1")

    Dim wsOutput As Worksheet
    Set wsOutput = ThisWorkbook.Worksheets("Sheet2")

    Dim ColumnList() As Variant
    ColumnList = Array("B", "E", "G")

    Dim LastRow As Long
    Dim CopyRng As Range

    Dim Col As Variant
    For Each Col In ColumnList
        LastRow = wsInput.Cells(wsInput.Rows.Count, Col).End(xlUp).Row

        If LastRow > 1 Then 'If data is found copy it
            Set CopyRng = wsInput.Range(wsInput.Cells(1, Col), wsInput.Cells(LastRow, Col))
            CopyRng.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=wsOutput.Cells(1, Col), Unique:=True
        Else 'If no data copy only header
            wsOutput.Cells(1, Col).Value = wsInput.Cells(1, Col).Value
        End If
    Next Col
End Sub