Переместить группу столбцов в 2 столбца

Question

У меня есть большой набор данных, в настоящее время организованный, по существу, во многих парах столбцов. Я пытаюсь сложить их всего в 2 столбца. Таким образом, в столбце A я хочу собрать данные из столбца A, C, E, et c .; в столбце B данные из столбцов B, D, F и т. д. c. Кто-нибудь знает какой-нибудь код VBA или другие советы, которые помогут быстро это исправить? Спасибо!

Answer 1

Поместите следующее в стандартный кодовый модуль ...

Sub CombineColumns()
    Dim a&, b&, i&, m&, j&, v, z

    With [a1].CurrentRegion
        v = .Value2
        z = [a:b]
        a = [counta(a:a)]
        b = [counta(b:b)]

        For j = 3 To UBound(v, 2)
            Select Case j Mod 2
                Case 1
                    For i = 1 To UBound(v, 1)
                        If Len(v(i, j)) = 0 Then Exit For
                        a = a + 1
                        z(a, 1) = v(i, j)
                    Next
                Case 0
                     For i = 1 To UBound(v, 1)
                        If Len(v(i, j)) = 0 Then Exit For
                        b = b + 1
                        z(b, 2) = v(i, j)
                    Next
            End Select
        Next

        .ClearContents
        m = a: If b > m Then m = b
        [a1:b1].Resize(m) = z
    End With
End Sub

---

Обновление

Вот измененная версия ...

Sub CombineColumns()
    Dim a&, b&, m&, j&, v, z

    With [a1].CurrentRegion
        z = [a:b]
        v = .Value2
        a = [counta(a:a)]
        b = [counta(b:b)]

        For j = 3 To UBound(v, 2)
            Select Case j Mod 2
                Case 1: ProcessColumn a, 1, j, v, z
                Case 0: ProcessColumn b, 2, j, v, z
            End Select
        Next

        .ClearContents
        m = a: If b > m Then m = b
        [a1:b1].Resize(m) = z
    End With
End Sub

Sub ProcessColumn(ndx&, d&, j&, v, z)
    Dim i&

    For i = 1 To UBound(v)
        If Len(v(i, j)) = 0 Then Exit For
        ndx = ndx + 1
        z(ndx, d) = v(i, j)
    Next

End Sub