VBA Excel – 将列按正确的顺序排列
所以最近我一直在研究使用定义的范围来复制数据，而不是select，复制和粘贴单元格。 这样我希望优化我的代码的性能和运行时间。
不幸的是我遇到了一个我自己无法解决的问题。
在定义范围时，我想按不同的顺序重新排列列。
例如：
Set my_range = Sheets("Sheet1").Range("A2:E2,G2:H2,J2:K2,M2") 工作得很好，因为填充到范围内的列在表单中相互位于后面。 但现在我有这个：
Set yo_range = Sheets("Sheet2").Range("D2,AV2,L2,H2,Q2,AE2,AG2")
如果我将这些范围填入新表中， yo_range将填充我放入的列，但不是按照我写下的顺序。 按照原来的顺序把它放下。 在这个例子中， yo_range将按照这个顺序把数据放到新的表中：
D2 | H2 | L2 | Q2 | AE2 | AG2 | AV2
我怎样才能解决这个问题？ 我想要的订单是比原来的另一个。 另外 – 正如你所看到的my_range比yo_range有更多的列。 我怎样才能让yo_range被填入新的表格中，但是在某些地方会留下列表呢？ 例如：
my_range（A2：E2）进入新表单中的A2：E2
yo_range（D2，AV2）在新的工作表中进入A：B，然后将C留出，然后将yo_range（L2，H2）粘贴到新工作表中的D：E中
我希望我能够很好地解释我的问题，并且有人愿意帮助我。 任何帮助表示赞赏。
编辑：
以下是将范围内的值放入新工作表的代码
Do If Application.WorksheetFunction.CountA(my_range) > 0 Then my_range.Copy ws.Range("A" & ws.Rows.Count).End(xlUp).Offset(1, 0) Set my_range = my_range.Offset(1, 0) Else Exit Do End If Loop Do If Application.WorksheetFunction.CountA(yo_range) > 0 Then yo_range.Copy ws.Range("A" & ws.Rows.Count).End(xlUp).Offset(1, 0) Set yo_range = yo_range.Offset(1, 0) Else Exit Do End If Loop
我们可以看到Copy方法将重新排列数据从左到右。 尝试这个：
Option Explicit Public Sub CheckClipboard() Dim ws As Worksheet Dim rngToCopy As Range Dim objData As Object Dim varContents As Variant ' test data b,c,d,e,f,g in Sheet1!B1:G1 Set ws = ThisWorkbook.Worksheets("Sheet1") ws.Range("B1:G1").Value = Array("b", "c", "d", "e", "f", "g") Set rngToCopy = ws.Range("E1:F1,G1,B1:C1") '<-- note not left-to-right order rngToCopy.Copy '<-- copy ' this is a late bound MSForms.DataObject Set objData = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") ' copy current cell formula to clipboard objData.GetFromClipboard varContents = objData.GetText Debug.Print varContents '<-- re-arranged left-to-right ' cancel copy Application.CutCopyMode = False End Sub
我在即时窗口得到这个：
bcdefg
所以，使用Copy不会为你想做的工作。
为了按照您在Range设置的顺序“粘贴”数据，您需要迭代Range每个Area ，然后遍历每个Area中的每个单元格（即Range ）。 请参阅下面的testing代码，其中复制您的问题并提出解决scheme：
Option Explicit Sub MixColumns() Dim ws As Worksheet Dim rngIn As Range Dim rngOut As Range Dim lng As Long Dim rngArea As Range Dim rngCell As Range Set ws = ThisWorkbook.Worksheets("Sheet1") ' example 1 Set rngIn = ws.Range("B1:C1,E1:F1,G1") '<-- 5 cells, non-contiguous, forward order Set rngOut = ws.Range("B2:F2") '<-- 5 contiguous cells rngIn.Copy rngOut '<-- works ' example 2 - OP problem Set rngIn = ws.Range("E1:F1,G1,B1:C1") '<-- 5 cells, non-contiguous, odd order Set rngOut = ws.Range("B3:F3") '<-- 5 contiguous cells rngIn.Copy rngOut '<-- should be e,f,g,b,c but gets b,c,e,f,g ' example 3 - solution for OP problem Set rngIn = ws.Range("E1:F1,G1,B1:C1") '<-- 5 cells, non-contiguous, odd order Set rngOut = ws.Range("B4:F4") '<-- 5 contiguous cells lng = 1 '<-- rngOut cell counter ' iterate areas For Each rngArea In rngIn.Areas ' iterate cells in area For Each rngCell In rngArea.Cells rngOut.Cells(1, lng).Value = rngCell.Value '<-- copy single value lng = lng + 1 '<-- increment rngOut counter Next rngCell Next rngArea '<-- results in e,f,g,b,c End Sub
给这个输出：
