时间戳

首页 > 解决方案 > 如何复制不连续的列并复制除前 2 行和最后 1 行之外的所有内容而不剪切？当行数很多时，剪切需要很长时间

excel - 如何复制不连续的列并复制除前 2 行和最后 1 行之外的所有内容而不剪切？当行数很多时，剪切需要很长时间

问题描述

如何复制不连续的列并复制除前 2 行和最后 1 行之外的所有内容而不剪切？当行数很多时，剪切需要很长时间。我重新排序后复制。我想复制而不重新排序，例如复制列 c、a、h、f、o、l 除了前 2 行和最后 1 行之外的所有内容

Columns("F:F").Select
Selection.Cut
Columns("D:D").Select
Selection.Insert Shift:=xlToRight
Columns("F:F").Select
Selection.Cut
Columns("E:E").Select
Selection.Insert Shift:=xlToRight
Columns("T:T").Select
Selection.Cut
Columns("G:G").Select
Selection.Insert Shift:=xlToRight
Columns("I:I").Select
Selection.Cut
Columns("H:H").Select
Selection.Insert Shift:=xlToRight
Columns("J:J").Select
Selection.Cut
Columns("I:I").Select
Selection.Insert Shift:=xlToRight
ActiveWindow.SmallScroll Down:=69
ActiveWindow.LargeScroll Down:=-4
Range(Range("C3"), Range("I3").End(xlDown).Offset(-1, 0)).Select
Selection.Copy

标签： excelvba

解决方案

通过Application.Index()函数重新排列列

这种快速方法不会复制单个范围，而是使用数组来代替，并演示该Application.Index()函数的高级可能性，允许通过单个代码行重新排列内部行和列结构（~> 参见下面[3]过程中的部分Sub Rearrange()）。

此解决方案假定您想要一个仅包含五个（原始）数据列C、A、和的新列顺序H，因此删除所有未包含的列 - 但如果您想进一步包含，您可以轻松地将常量更改为任何其他组合或所有列。FONEWCOLUMNORDER

主要程序Rearrange


Sub ReArrange()
With Sheet1             ' using the CodeName of a sheet, see (Name) in Property Tool Window
  Const NEWCOLUMNORDER As String = "C,A,H,F,O"
  ' [0] Define data range as well as first and last row (checking e.g. column A:A)
    Dim firstRow As Long, lastRow As Long
    firstRow = 3: lastRow = .Range("A" & .Rows.count).End(xlUp).Row
    Dim rng As Range
    Set rng = .Range("A" & firstRow & ":O" & lastRow - 1) ' start from 3rd row
  ' [1] assign data values to (1-based) 2-dimensional variant array
    Dim v As Variant
    v = rng.Value2
  ' [2] empty original data range (omitting last row)
    rng.Resize(lastRow - firstRow).Clear
  ' [3] Rearrange array rows & columns
    v = Application.Index(v, _
        Evaluate("row(1:" & lastRow - firstRow & ")"), _
        ColNos(NEWCOLUMNORDER))
  ' [4] Write array back to range
    rng.Resize(UBound(v), UBound(v, 2)) = v
End With
End Sub

请注意，我更喜欢使用CodeName与您的 VBA 项目相关联的工作表的唯一性（~> 请参见代码行With Sheet1）避免例如通过工作表选项卡重命名工作表后的问题（默认情况下，其名称与CodeNameVBE 窗口中的名称相同(Name)，括号中！ ）。当然也可以参考eg With ThisWorkbook.Worksheets("Sheet1")。

辅助函数ColNos()

Function ColNos(ByVal s, Optional ByVal DELIM$ = ",") As Variant()
'Purpose: return array of column numbers
'Example: "C,A,H,F,O" ~~> Array(3,1,8,6,15)
s = Split(s, DELIM)         ' split string into individual column letters
ReDim tmp(0 To UBound(s))   ' define array's (1st) dimension via array indices
Dim i&                      ' zero based items counter
For i = 0 To UBound(s)      ' loop through column letters, e.g. C,A,H,F,O
    tmp(i) = Columns(s(i) & ":" & s(i)).Column ' get column number
Next i
ColNos = tmp                ' return temporary array items
End Function

推荐阅读