Question

我在一天中多次从Tableau中提取数据（50-150x）。我们谈论的是100多列，以及5到5000行。一个问题是Tableau按字母顺序按标题对列进行排序，但我需要按特定顺序排序。所以，我记录了一个手动切割/插入每一行的宏 - 这是永远的。然后我删除了“滚动”代码，同时禁用了屏幕更新以加快它的速度，但它仍然很慢。有时需要超过45秒才能运行。考虑到我在一天内执行此任务的速率，这比我所知的要慢得多。最终，我需要按以下顺序映射列：

Tableau Column  |   Becomes
----    ----    ----
L   |   A
AH  |   B
CD  |   C
AG  |   D
AO  |   E
J   |   F
AX  |   G
AZ  |   H
AQ  |   I
AR  |   J
BB  |   K
BC  |   L
AT  |   M
AS  |   N
AU  |   O
AV  |   P
AW  |   Q
BA  |   R
AY  |   S
BJ  |   T
BY  |   U
BF  |   V
CA  |   W
CB  |   X
BG  |   Y
BZ  |   Z
CC  |   AA
B   |   AB
C   |   AC
D   |   AD
E   |   AE
CU  |   AF
BH  |   AG
BI  |   AH
CW  |   AI
BX  |   AJ
BW  |   AK
BV  |   AL
DC  |   AM
DA  |   AN
DB  |   AO
K   |   AP
BK  |   AQ
BL  |   AR
BM  |   AS
BN  |   AT
BO  |   AU
BP  |   AV
BQ  |   AW
BR  |   AX
BS  |   AY
BT  |   AZ
BU  |   BA
CZ  |   BB
AP  |   BC
BD  |   BD
AF  |   BE
CE  |   BF
CF  |   BG
CG  |   BH
CT  |   BI
A   |   BJ
BE  |   BK
N   |   BL
O   |   BM
CH  |   BN
CI  |   BO
CJ  |   BP
CK  |   BQ
CL  |   BR
CM  |   BS
CN  |   BT
CO  |   BU
CP  |   BV
CQ  |   BW
CR  |   BX
CS  |   BY
F   |   BZ
G   |   CA
H   |   CB
I   |   CC
R   |   CD
P   |   CE
AI  |   CF
AM  |   CG
AB  |   CH
AK  |   CI
AE  |   CJ
W   |   CK
M   |   CL
S   |   CM
Q   |   CN
Y   |   CO
AN  |   CP
V   |   CQ
AJ  |   CR
T   |   CS
AL  |   CT
AD  |   CU
Z   |   CV
AC  |   CW
U   |   CX
CV  |   CY
AA  |   CZ
CY  |   DA
X   |   DB
CX  |   DC

我试过基于它的代码，但是我很快就知道，在移动一列后，所有进行中的列都会移动。彻底失败！我非常渴望创意！

Answer 1

Excel允许您对列进行排序。您必须调整NewOrder数组，但它会在不到1秒的时间内对数据进行排序。

Sub SortColumns()
    Application.ScreenUpdating = False
    Const SHEET_NAME As String = "Sheet1"
    Dim Target As Range
    Dim NewOrder As Variant
    NewOrder = Array(12, 34, 82, 33, 41, 10, 50, 52, 43, 44, 54, 55, 46, 45, 47, 48, 49, 53, 51, 62, 77, 58, 79, 80, 59, 78, 81, 2, 3, 4, 5, 99, 60, 61, 101, 76, 75, 74, 107, 105, 106, 11, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 104, 42, 56, 32, 83, 84, 85, 98, 1, 57, 14, 15, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, 6, 7, 8, 9, 18, 16, 35, 39, 28, 37, 31, 23, 13, 19, 17, 25, 40, 22, 36, 20, 38, 30, 26, 29, 21, 100, 27, 103, 24, 102)
    With ThisWorkbook.Worksheets(SHEET_NAME)
        .Rows(1).Insert Shift:=xlDown
        .Range("A1").Resize(1, UBound(NewOrder) + 1).Value = NewOrder
        Set Target = .Range("A1").CurrentRegion
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=Target.Rows(1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
                             xlSortNormal
        With .Sort
            .SetRange Target
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlLeftToRight
            .SortMethod = xlPinYin
            .Apply
        End With
        .Rows(1).Delete Shift:=xlUp
    End With
    Application.ScreenUpdating = True
End Sub

VBA重组100多个专栏？

1 个答案: