![VBA 宏用于交换列](https://linux22.com/image/1462938/VBA%20%E5%AE%8F%E7%94%A8%E4%BA%8E%E4%BA%A4%E6%8D%A2%E5%88%97.png)
请您帮助我使用 VBA 宏来交换列
例如有 4 列
供应商 1、供应商 2、供应商得分 1、供应商得分 2
我想更改以下列
供应商 1、供应商得分 1、供应商 2、供应商得分 2
我已经使用了下面的代码
列(“I:I”)。选择所选内容。剪切列(“D:D”)。选择所选内容。插入 Shift:=xlToRight
答案1
您可能会发现我在此处的迷你博客中发布的代码有些有趣......
http://www.excelfox.com/forum/f22/swapping-rearranging-multiple-columns-of-data-493/
答案2
您的规范并不完全清楚。但您似乎想将列的前半部分与后半部分交错。这可以在 VBA 中相当简单快速地完成。我已经做出了假设,您需要编辑这些假设,即原始数据的位置以及您想要放置结果的位置。我还假设数据是连续的,如代码注释中所述。
这是在 VBA 数组中实现的,因为重复访问工作表的例程要慢得多。
所用的算法:
- 将数据读入二维变量数组
- 创建第二个数组来保存结果,大小与第一个数组相同
- 通过交错第一半列范围和第二半列范围来填充第二个数组。
- 将结果数组写入工作表范围。
- 格式化结果
Option Explicit
Sub InterleaveColumns()
Dim wsORIG As Worksheet, wsRESULT As Worksheet, rRESULT As Range
Dim lNumCols As Long
Dim vORIG As Variant, vRESULT() As Variant
Dim I As Long, J As Long
'Place Results starting on Sheet3!A1
Set wsRESULT = Worksheets("Sheet3")
Set rRESULT = wsRESULT.Cells(1, 1)
'Assuming the data table starts Sheet2!A1 and is contiguous
'Adjust algorithm as required
Set wsORIG = Worksheets("Sheet2")
'Place data into a 2D Variant Array
vORIG = wsORIG.Cells(1, 1).CurrentRegion
'Number of columns
lNumCols = UBound(vORIG, 2)
'Sanity check
If lNumCols Mod 2 <> 0 Then
MsgBox ("Must have Even number of columns")
Exit Sub
End If
'Create results array
ReDim vRESULT(1 To UBound(vORIG, 1), 1 To UBound(vORIG, 2))
'Populate results array with interleaving
For I = 1 To UBound(vORIG, 1)
For J = 1 To UBound(vORIG, 2) / 2
vRESULT(I, (J - 1) * 2 + 1) = vORIG(I, J)
vRESULT(I, (J - 1) * 2 + 2) = vORIG(I, J + lNumCols / 2)
Next J
Next I
'Write results array to some worksheet and range
Set rRESULT = rRESULT.Resize(UBound(vRESULT, 1), UBound(vRESULT, 2))
With rRESULT
.EntireColumn.Clear
.Value = vRESULT
With .Rows(1)
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
.EntireColumn.AutoFit
End With
End Sub