☰

VBA 重新格式化循环

tag-icon • tag-icon microsoft-excel
VBA 重新格式化循环

我无法为我的宏创建这个循环。我已将其全部硬编码，并且它可以正常工作。但如果我得到一个更长的列表，它就会不足。所以，我正在尝试重新格式化这个箱子列表。现在，当我们创建列表时，它会将所有内容上传到一列中。我想要一个循环，从 A 列中剪切 22 行并将其粘贴到下一列中，仅使用 A、B、C 列。然后重复。附件是一个可怕的例子，下面是我现在从记录宏功能中获得的硬代码。

    ActiveCell.Offset(22, 0).Range("A1:A22").Select

    Selection.Cut

    ActiveCell.Offset(-22, 1).Range("Data[[#Headers],[Code_Bin]]").Select

    ActiveSheet.Paste

    ActiveCell.Offset(44, -1).Range("A1:A22").Select

    Selection.Cut

    ActiveCell.Offset(-44, 2).Range("Data[[#Headers],[Code_Bin]]").Select

    ActiveSheet.Paste

    ActiveCell.Offset(66, -2).Range("A1:A22").Select

   Selection.Cut

    ActiveCell.Offset(-44, 0).Range("Data[[#Headers],[Code_Bin]]").Select

    ActiveSheet.Paste

    ActiveCell.Offset(66, 0).Range("A1:A22").Select

    Selection.Cut

    ActiveCell.Offset(-66, 1).Range("Data[[#Headers],[Code_Bin]]").Select

    ActiveSheet.Paste

    ActiveCell.Offset(88, -1).Range("A1:A22").Select

    Selection.Cut

    ActiveCell.Offset(-88, 2).Range("Data[[#Headers],[Code_Bin]]").Select

    ActiveSheet.Paste

    Range("A133:A154").Select

    Selection.Cut

    Range("A45").Select

    ActiveSheet.Paste

    Range("A155:A176").Select

    Selection.Cut

    Range("B45").Select

    ActiveSheet.Paste

    Range("A177:A198").Select

    Selection.Cut

    Range("C45").Select

    ActiveSheet.Paste

    Range("A199:A220").Select

    Selection.Cut

    Range("A67").Select

    ActiveSheet.Paste

    Range("A221:A242").Select

    Selection.Cut

    Range("B67").Select

    ActiveSheet.Paste

    Range("A243:A264").Select

    Selection.Cut

    Range("C67").Select

    ActiveSheet.Paste

    Range("A265:A286").Select

    Selection.Cut

    Range("A89").Select

    ActiveSheet.Paste

    Range("A287:A308").Select

    Selection.Cut

    Range("B89").Select

    ActiveSheet.Paste

    Range("A309:A330").Select

    Selection.Cut

    Range("C89").Select

    ActiveSheet.Paste

    Range("A331:A352").Select

    Selection.Cut

    Range("A111").Select

    ActiveSheet.Paste

    Range("A353:A374").Select

    Selection.Cut

    Range("B111").Select

    ActiveSheet.Paste

    Range("A375:A396").Select

    Selection.Cut

    Range("C111").Select

    ActiveSheet.Paste

    Range("A397:A418").Select

    Selection.Cut

    Range("A133").Select

    ActiveSheet.Paste

    Range("A419:A440").Select

    Selection.Cut

    Range("B133").Select

    ActiveSheet.Paste

    Range("A441:A462").Select

    Selection.Cut

    Range("C133").Select

    ActiveSheet.Paste

    Range("A463:A484").Select

    Selection.Cut

    Range("A155").Select

    ActiveSheet.Paste

    Range("A485:A506").Select

    Selection.Cut

    Range("B155").Select

    Application.CutCopyMode = False

    Selection.Copy

    ActiveSheet.Paste

    Range("C165").Select

    Range("A485:A505").Select

    Application.CutCopyMode = False

    Selection.Cut

    Range("B155").Select
    ActiveSheet.Paste

    Range("A506").Select

    Selection.Cut

    Range("B176").Select

    ActiveSheet.Paste

    Range("A507:A528").Select

    Selection.Cut

    Range("C155").Select

    ActiveSheet.Paste

    Range("A529:A550").Select

    Selection.Cut

    Range("A177").Select

    ActiveSheet.Paste

    Range("A551:A572").Select

    Selection.Cut

    Range("B177").Select

    ActiveSheet.Paste

   Range("A573:A594").Select

    Selection.Cut

    Range("C177").Select

    ActiveSheet.Paste

    Range("A595:A616").Select

    Selection.Cut

    Range("A199").Select

    ActiveSheet.Paste

    Range("A617:A638").Select

    Selection.Cut

    Range("B199").Select

    ActiveSheet.Paste

    Range("A639:A660").Select

    Selection.Cut

    Range("C199").Select

    ActiveSheet.Paste

    Range("A661:A682").Select

    Selection.Cut

    Range("A221").Select

    ActiveSheet.Paste

    Range("A683:A704").Select

    Selection.Cut

    Range("B221").Select

    ActiveSheet.Paste

    Range("A705:A726").Select

    Selection.Cut

    Range("C221").Select

    ActiveSheet.Paste

    Range("A727:A748").Select

    Selection.Cut

    Range("A243").Select

    ActiveSheet.Paste

    Range("A749:A770").Select

    Selection.Cut

    Range("B243").Select

    ActiveSheet.Paste

    Range("A771:A792").Select

    Selection.Cut

    Range("C243").Select

    ActiveSheet.Paste

    Range("A793:A814").Select

    Selection.Cut

    Range("A265").Select

    ActiveSheet.Paste

    Range("A815:A836").Select

    Selection.Cut

    Range("B265").Select

    ActiveSheet.Paste

    Range("A837:A858").Select

    Selection.Cut

    Range("C265").Select

    ActiveSheet.Paste

    Range("A859:A880").Select

    Selection.Cut

    Range("A287").Select

    ActiveSheet.Paste

    Range("A881:A902").Select

    Selection.Cut

    Range("B287").Select

    ActiveSheet.Paste

    Range("A903:A924").Select

    Selection.Cut

    Range("C287").Select

    ActiveSheet.Paste

    Range("A925:A946").Select

    Selection.Cut

    Range("A309").Select

    ActiveSheet.Paste

    Range("A947:A968").Select

    Selection.Cut

    Range("B309").Select

    ActiveSheet.Paste

    Range("A969:A990").Select

    Selection.Copy

    Application.CutCopyMode = False

    Selection.Cut

    Range("C309").Select

    ActiveSheet.Paste

    Range("A991:A1012").Select

    Selection.Cut

    Range("A331").Select

    ActiveSheet.Paste

    Range("A1013:A1034").Select

    Selection.Cut

    Range("B331").Select

    ActiveSheet.Paste

    Range("A1035:A1056").Select

    Selection.Cut

    Range("C331").Select

    ActiveSheet.Paste

    Range("A1057:A1078").Select

    Selection.Cut

    Range("A353").Select

    ActiveSheet.Paste

    Range("A1079:A1100").Select

    Selection.Cut

    Range("B353").Select

    ActiveSheet.Paste

    Range("A1101:A1122").Select

    Selection.Cut

    Range("C353").Select

    ActiveSheet.Paste

    Range("A1123:A1144").Select

    Selection.Cut

    Range("A375").Select

    ActiveSheet.Paste

 

End Sub

在此处输入图片描述

答案1

总是尝试重写记录的代码。

摆脱.Select和Selection.

    Range("A177:A198").Select
    Selection.Cut
    Range("C45").Select
    ActiveSheet.Paste

相同于

    Range("A177:A198").Cut Range("C45")

这里有一些示例代码可以帮助您重写代码。

使用 F8 单步执行第一个宏来查看其工作原理

Sub Macro1()

    Range("A1:Z100").Value = Null                           ' clear destination range
    
    Stop ' single step this code by pressing F8
    
    b = 0                                                   ' destination column pointer
    
    x = 6                                                   ' size of the data "blocks"
    
    For a = 0 To 100 Step x
        Range("A1").Offset(a, 0).Resize(x).Select           ' this is only for debugging for visually verifying that the correct range
        Range("C1").Offset(3, b).Resize(x).Select           ' is being accessed. it has no effect on the movement of values between cells
        
        Range("e1").Select                                  ' select out of way cell
        
        Range("A1").Offset(a, 0).Resize(x).Value = a        ' cells do not need to be selected
        Range("C1").Offset(3, b).Resize(x).Value = a
        
        b = b + 1                                           ' point to next column
    Next a
    
End Sub

此宏执行复制操作。请阅读注释以获取解释。

Sub copyRanges()

    Range("A1:Z22").Value = Null                    ' clear destination range
    
    Range("A1").Value = 0                           ' fill source range with test data
    Range("A1").AutoFill Destination:=Range("A1:A1000"), Type:=xlFillSeries

    b = 0                                           ' destination column number
    x = 13                                          ' length of data blocks
    
    Stop                                            ' use F8 to single-step through rest of code
    
    For a = 0 To 100 Step x
        
        Range("C1").Offset(3, b).Resize(x).Value = Range("A1").Offset(a, 0).Resize(x).Value    ' this assigns values (does not do any "copy" function)
        
'       Range("A1").Offset(a, 0).Resize(x).Cut Range("C1").Offset(3, b)                        ' this copies formatting also, but is slow
        
        b = b + 1                                   ' point to next destination column
    
    Next a
    
    Range("A1:A1000").Value = Null                  ' clear source data
    
End Sub

相关内容