将多个列堆积成两个柱子，两个成对

Question

我有填充了数据的列A:ALC，并且每列都有不同数量的行。如果可能的话，我需要一个将成对堆叠两列的宏。例如，列C直接在列A和列D直接列B等等所有列A:ALC。

 COLUMN A COLUMN B   COLUMN C  COLUMN D 
ROW 1 2598  F800    2599   F800 
ROW 2 2598  K1300    2599   K1300 
ROW 3 2598  S1000RR   2599   R900 
ROW 4 2598  G650    2599   G650 
ROW 5 2598  R1200    2599   K1600 
ROW 6 2599  S1000 
ROW 7 2599  HP2 
ROW 8 2599  R1200 

没有为每对列（例如，列A和B有8行，列C和D有5行，等等）的数据的等量，但是行数，显然，不同在许多列对之间。数据中没有空白。

当我跑到你给Excel中显示此宏：

运行时错误 '13'：类型不匹配

可能是什么问题？

注意：有一些只有一对数据的列，也就是只有第一行的数据。

这是我所需要的输出看起来像：

 COLUMN A COLUMN B   
ROW 1 2598  F800    
ROW 2 2598  K1300    
ROW 3 2598  S1000RR 
ROW 4 2598  G650    
ROW 5 2598  R1200    
ROW 6 2599  S1000 
ROW 7 2599  HP2 
ROW 8 2599  R1200 
ROW 9 2599  F800 
ROW 10 2599  K1300 
ROW 11 2599  R900 
ROW 12 2599  G650 
ROW 13 2599  K1600 

Answer 1

如果您的数据范围从：ALC是满的，那么这个变量数组代码将很快形成列A和B你的新范围

请注意，如果遇到空白或单个单元格列，代码将失败，因为变体数组无法创建。如果是这种情况，那么我将需要添加范围测试，所以请指教。

[更新处理空白的范围和/或单个细胞]

Sub Combine() 
Dim OrigA 
Dim OrigB 
Dim strA As String 
Dim strB As String 
Dim strDelim As String 
Dim lngCol As Long 

strDelim = "||" 
strA = Join(Application.Transpose(Range([a1], Cells(Rows.Count, "A").End(xlUp))), strDelim) 
strB = Join(Application.Transpose(Range([b1], Cells(Rows.Count, "b").End(xlUp))), strDelim) 

For lngCol = Columns("C").Column To Columns("ALC").Column - 2 Step 2 
    If Application.CountA(Columns(lngCol)) > 1 Then 
    'handle odd column range 
     strA = strA & (strDelim & Join(Application.Transpose(Range(Cells(1, lngCol), Cells(Rows.Count, lngCol).End(xlUp))), strDelim)) 
    Else 
    'handle odd column single cell 
     If Len(Cells(1, lngCol)) > 0 Then strA = strA & (strDelim & Cells(1, lngCol).Value) 
    End If 
     If Application.CountA(Columns(lngCol + 1)) > 1 Then 
     'handle even column range 
    strB = strB & (strDelim & Join(Application.Transpose(Range(Cells(1, lngCol + 1), Cells(Rows.Count, lngCol + 1).End(xlUp))), strDelim)) 
    Else 
    'handle even column single cell 
    If Len(Cells(1, lngCol + 1)) > 0 Then strB = strB & (strDelim & Cells(1, lngCol + 1).Value) 
    End If 
Next 

OrigA = Application.Transpose(Split(strA, strDelim)) 
OrigB = Application.Transpose(Split(strB, strDelim)) 

[a1].Resize(UBound(OrigA, 1), 1) = OrigA 
[b1].Resize(UBound(OrigB, 1), 1) = OrigB 

End Sub