时间戳

首页 > 解决方案 > 我需要为唯一输出创建一个循环，将其复制到同一个工作表中的不同列

excel - 我需要为唯一输出创建一个循环，将其复制到同一个工作表中的不同列

问题描述

我有以下代码：

Private Sub Unique_Click()

Dim xRng As Range
Dim xLastRow As Long
Dim xLastRow2 As Long
Dim i As Integer
On Error Resume Next

Set xRng = Worksheets("Data1").Range(Range("C15"))
If xRng Is Nothing Then Exit Sub
On Error Resume Next
xRng.Copy Range("B21")
xLastRow = xRng.Rows.Count + 1
ActiveSheet.Range("B21:B" & xLastRow).RemoveDuplicates Columns:=1, Header:=xlNo

Set xRng = Worksheets("Data2").Range(Range("O15"))
If xRng Is Nothing Then Exit Sub
On Error Resume Next
xRng.Copy Range("N21")
xLastRow = xRng.Rows.Count + 1
ActiveSheet.Range("N21:N" & xLastRow).RemoveDuplicates Columns:=1, Header:=xlNo

Set xRng = Worksheets("Data3").Range(Range("AA15"))
If xRng Is Nothing Then Exit Sub
On Error Resume Next
xRng.Copy Range("Z21")
xLastRow = xRng.Rows.Count + 1
ActiveSheet.Range("Z21:Z" & xLastRow).RemoveDuplicates Columns:=1, Header:=xlNo

End Sub

我需要循环这个。或者，我必须重复 31 次（一个月内最多天数）。输出列之间的空间始终相同。即B21、N21的区别；Z21等。

有什么建议么？否则，我将手动进行。

标签： excelvbaloops

解决方案

也许这样的事情会有所帮助：

Private Sub Unique_Click()
    Dim xRng As Range
    Dim xLastRow As Long
    Dim xLastRow2 As Long
    Dim i As Integer
    Dim colNo As Integer

    On Error Resume Next

    For colNo = 3 To 27 Step 12
        Set xRng = Worksheets("Data1").Cells(15, colNo)
        If xRng Is Nothing Then Exit Sub

        xRng.Copy Cells(21, colNo - 1)
        xLastRow = xRng.Rows.Count + 1
        ActiveSheet.Range(Cells(21, colNo - 1), Cells(xLastRow, colNo - 1)).RemoveDuplicates Columns:=1, Header:=xlNo
    Next colNo
End Sub

您只需要遍历 ColNo（步长 = 12，这意味着我们在每个循环中添加 12 列），从 C 列 (3) 开始，到 AA 列 (27) 结束。

我还建议添加工作表名称以xRng.Copy Cells(21, colNo - 1)确保代码在正确的位置运行。

还有一个提示——你不需要使用On Error Resume Next这么多次。它会一直保持活动状态，直到您使用 将其“关闭” On Error GoTo 0。

希望能帮助到你。

推荐阅读