Question

我试图结合一个简单的循环代码和选择案例来返回所需的用户结果（我知道代码不正确）。在J列中，我有一系列的年份，从2012年到2017年，取决于J列中的年份，我希望将数据从U列切换到AG并将其粘贴到正确的位置。

我提出的代码如下;

Sub Move_data()

Dim rng As Range
Dim LR As Long
LR = Range("J1048576").End(xlUp).Row
Set rng = Range(Cells(2, 10), Cells((LR), 10))

For x = 2 To LR Step 1
Select Case Range("J" & x).Value2
        Case 2012
            Range("BU" & x).Cut
            Range("IH" & x).Paste
            Range("U" & x, ":CG" & x).Cut
            Range("AH" & x).PasteSpecial
            ActiveSheet.Outline.ShowLevels RowLevels:=0, ColumnLevels:=1
        Case 2013
            Range("BU" & x).Cut
            Range("IH" & x).Paste
            Range("U" & x, ":CG" & x).Cut
            Range("AU" & x).PasteSpecial
            ActiveSheet.Outline.ShowLevels RowLevels:=0, ColumnLevels:=1
        Case 2014
            Range("BU" & x).Cut
            Range("IH" & x).Paste
            Range("U" & x, ":CG" & x).Cut
            Range("BH" & x).PasteSpecial
            ActiveSheet.Outline.ShowLevels RowLevels:=0, ColumnLevels:=1
        Case 2015
            Range("BU" & x).Cut
            Range("IH" & x).Paste
            Range("U" & x, ":CG" & x).Cut
            Range("BU" & x).PasteSpecial
            ActiveSheet.Outline.ShowLevels RowLevels:=0, ColumnLevels:=1
        Case 2016
            Range("BU" & x).Cut
            Range("IH" & x).Paste
            Range("U" & x, ":CG" & x).Cut
            Range("CH" & x).PasteSpecial
            ActiveSheet.Outline.ShowLevels RowLevels:=0, ColumnLevels:=1
        Case 2017
            Range("BU" & x).Cut
            Range("IH" & x).Paste
            Range("U" & x, ":CG" & x).Cut
            Range("CU" & x).PasteSpecial
            ActiveSheet.Outline.ShowLevels RowLevels:=0, ColumnLevels:=1

           End Select

             x = x + 1
            Else
            End If
            Next x


            End Sub

此外，我感觉循环每行可能没有时间效率，因为文件中有超过1000行。排序和选择所有相同年份并一次移动数据可能更快。（但我不确定如何做到这一点）

任何有关代码调整的帮助或指导实现此目的的最佳方法将非常感谢！我附上了一张图片，以指导我想要实现的目标。

Answer 1

虽然这不会完全符合您的要求，但它会让您了解如何开始使用表格。这将检测表中的唯一值（而不是设置您的案例），然后尝试跟踪它。您必须将数据源转换为表格（listobject），还有一些其他需要修改的内容（尝试用注释突出显示它们。仔细查看代码并随意如果有问题可以提出任何问题。

数据来源（表格）

<强>代码

Option Explicit

Sub tableLoop()
    Dim ws As Worksheet
    Dim tbl As ListObject
    Dim i As Integer: Dim NoRow As Integer
    Dim arr() As Variant
    Dim c

    With Application
        .ScreenUpdating = False
    End With

    Set ws = ActiveSheet
    Set tbl = ws.ListObjects(1)

    On Error Resume Next
    ws.ShowAllData
    On Error GoTo 0

    ' first we will sort the table into order on year
    With tbl.Sort
        .SortFields.Clear
        ' Change the Range to match your table and year column)
        .SortFields.Add Key:=Range("Table1[[#All],[Project Year]]"), SortOn:=xlSortOnValues, _
            Order:=xlAscending, DataOption:=xlSortNormal
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    ' Get unique values in project year and put into array

    With tbl.ListColumns(1).DataBodyRange
        .AdvancedFilter Action:=xlFilterInPlace, Unique:=True
    End With
    i = 0
    For Each c In tbl.ListColumns(1).DataBodyRange.SpecialCells(xlCellTypeVisible)
        ReDim Preserve arr(0 To i)
        arr(i) = c.Value
        i = i + 1
    Next c

    ' Change this loop for however you want the output to be
    For i = 1 To UBound(arr)
        Debug.Print arr(i)
        With tbl
            .Range.AutoFilter Field:=1, Criteria1:=arr(i)
            .ListColumns(2).DataBodyRange.SpecialCells(xlCellTypeVisible).Copy
        End With
        With ws
            NoRow = i
            .Cells(NoRow, 5) = arr(i)
            .Cells(NoRow, 6).PasteSpecial Paste:=xlPasteValues, Transpose:=True
            On Error Resume Next
            .ShowAllData
            On Error GoTo 0
        End With
    Next i

    With Application
        .ScreenUpdating = True
    End With

End Sub

<强>输出

Answer 2

在我仓促查看您的代码时，看起来只有Range(...).PasteSpecial行在不同情况之间有所不同。您可以删除Select Case结构，而是创建一个包含PasteSpecial：cols = {"AH", "AU", "BH", "BU", "CH", "CU"}列的数组。然后，您可以按TheCol = cols(year-2011)选择列。

另一种方式：由于列有规律地间隔（相隔13个），因此您可以使用列号：col_num = 13*(year-2011) + 21。然后使用Range.Cells(x, col_num)。

之类的内容

希望有所帮助

循环与“选择案例”相结合

2 个答案: