将多列堆叠成两列，两列 [英] Stack multiple columns into two colums in pairs of two

问题描述

我有列 A：ALC 填充数据，每列有不同行数。如果可能的话，我需要一个宏，它将堆叠成两列的列。例如，列 C 直接在列 A 和列 D 直接在列 B 之下，对于所有列 A：ALC 。

I have columns A:ALC filled with data, and there is a varied number of rows for each column. If possible, I need a macro that will stack columns in pairs of two. For example, column C directly under column A and column D directly under column B and so on for all columns 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行，依此类推），但行数显然在许多列之间有所不同。数据中没有空白。

There is equal amount of data for each pair of columns (e.g. column A and B have 8 rows, column C and D have 5 rows, and so on), but the number of rows, obviously, differ between the many pairs of columns. There are no blanks trapped inside the data.

当我运行宏时，您给出了Excel显示：

When I ran the macro you gave Excel displayed this:

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

Run-Time Error '13': Type Mismatch

可能是什么问题？

注意：有一些列只有一对数据，即数据只在第一行。

NOTE: There are some columns with only a pair of data, that is data only in the first row.

这是我需要的输出如下所示：

This is what I need the output to look like:

       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

推荐答案

如果A：ALC的数据范围是完整的，那么这个变体数组代码将很快形成您在列A和B中的新范围

If your data range from A:ALC is full, then this variant array code will very quickly form your new range in columns A and B

注意注意事项，如果遇到空白或单身ll列作为变体数组不能被creaed。如果是这种情况，那么我将需要添加范围测试，因此请指教。

Note the caveat re full, the code will fail if it encounters a blank or single cell column as a variant array cant be creaed. If this is the case then I will need to add range testing, so pls advise.

[已更新以处理空白范围和/或单个单元格] strong>

[Updated to handle blank ranges and/or single cells]

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

这篇关于将多列堆叠成两列，两列的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！