EXCEL VBA 将多列转换为多行,列之间有间隙

Posted

技术标签:

【中文标题】EXCEL VBA 将多列转换为多行,列之间有间隙【英文标题】:EXCEL VBA Transpose multiple columns to multiple rows with gaps inbetween columns 【发布时间】:2018-06-22 05:12:13 【问题描述】:

我有一个大数据集要转置,下面的代码在正确的输出中完全做到了这一点,但是列太多了。目前,代码将不断地从一列到另一列读取,直到它们全部包含在内。我想更改此设置,以便我可以选择第一列数据,跳过 3 列然后继续执行脚本。

My Dataset:
UFI   CAT1    CAT2    CAT3    CAT4   CAT5   CAT6
RN1   Skip1   Skip2   Skip3   Copy1  Copy2  Copy3
RN2   Skip1   Skip2   Skip3   Copy1  Copy2  Copy3

Desired Output:
UFI    COLUMN   VALUES
RN1    CAT5     Copy1
RN1    CAT6     Copy2
RN1    CAT7     Copy3
RN2    CAT5     Copy1
RN2    CAT6     Copy2
RN2    CAT7     Copy3

下面是 VBA 代码:

Option Explicit

Sub Tester()

Dim p

'get the unpivoted data as a 2-D array
p = UnPivotData(Sheets("Sheet1").Range("A1").CurrentRegion, _
                3, True, False)

Dim r As Long, c As Long
For r = 1 To UBound(p, 1)

    For c = 1 To UBound(p, 2)
        Sheets("Sheet2").Cells(r, c).Value = p(r, c)
    Next c

Next r

End Sub

Function UnPivotData(rngSrc As Range, fixedCols As Long, _
                 Optional AddCategoryColumn As Boolean = True, _
                 Optional IncludeBlanks As Boolean = True)

Dim nR As Long, nC As Long, data, dOut()
Dim r As Long, c As Long, rOut As Long, cOut As Long, cat As Long
Dim outRows As Long, outCols As Long

data = rngSrc.Value                          'get the whole table as a 2-D 
array
nR = UBound(data, 1)                         'how many rows
nC = UBound(data, 2)                         'how many cols

'calculate the size of the final unpivoted table
outRows = nR * (nC - fixedCols)
outCols = fixedCols + IIf(AddCategoryColumn, 2, 1)

'resize the output array
ReDim dOut(1 To outRows, 1 To outCols)

'populate the header row
For c = 1 To fixedCols
    dOut(1, c) = data(1, c)
Next c
If AddCategoryColumn Then
    dOut(1, fixedCols + 1) = "COLUMN"
    dOut(1, fixedCols + 2) = "VALUES"
Else
    dOut(1, fixedCols + 1) = "VALUES"
End If


'populate the data
rOut = 1
For r = 2 To nR
    For cat = fixedCols + 1 To nC


        If IncludeBlanks Or Len(data(r, cat)) > 0 Then
            rOut = rOut + 1
            'Fixed columns...
            For c = 1 To fixedCols
                dOut(rOut, c) = data(r, c)
            Next c
            'populate unpivoted values
            If AddCategoryColumn Then
                dOut(rOut, fixedCols + 1) = data(1, cat)
                dOut(rOut, fixedCols + 2) = data(r, cat)
            Else
                dOut(rOut, fixedCols + 1) = data(r, cat)
            End If
        End If

    Next cat
Next r

UnPivotData = dOut
End Function

【问题讨论】:

数据集实际上大约有 15 列长,并扩展到 500+ 行。非常感谢有关如何编辑范围以包含我的更改的任何指导 一个快速的解决方法是将数据复制到另一个工作表,删除不需要的列,然后在副本上按原样使用代码 太专注于代码让我头脑一片空白,只是在您发布的时候意识到这一点:) 感谢您对该代码的指导。肯定有很大帮助 【参考方案1】:

只是为了它:

Sub Skip_and_Transpose()

Dim Ws1 As Worksheet: Set Ws1 = Sheets(1)
Dim Ws2 As Worksheet: Set Ws2 = Sheets(2)
Dim P1 As Range: Set P1 = Ws1.UsedRange
T1 = P1
Dim T2()
a = 1

ReDim Preserve T2(1 To 3, 1 To a)
T2(1, a) = "UFI"
T2(2, a) = "COLUMN"
T2(3, a) = "VALUES"
a = a + 1

For i = 2 To UBound(T1)
    For j = 5 To UBound(T1, 2)
        ReDim Preserve T2(1 To 3, 1 To a)
        T2(1, a) = T1(i, 1)
        T2(2, a) = T1(1, j)
        T2(3, a) = T1(i, j)
        a = a + 1
    Next j
Next i

Ws2.Range("A1").Resize(UBound(T2, 2), UBound(T2)) = Application.Transpose(T2)

End Sub

【讨论】:

谢谢,这种方法速度更快。您能否展示如何编辑跳过的列数?例如,如果我希望它收集第一列,跳过接下来的 10 列,然后从第 11 列继续? 从头开始,刚刚找到。 "对于 j = 5 到 Ubound" 是的,从索引 5 开始跳过前 4 列。如果你想在列之间跳过,你可以在循环中添加一个IF/END IF 条件,比如If j < 2 or j > 4 then ...就在For j = 1 to Ubound(T1,2)之后【参考方案2】:

感谢 Tims 的帮助,我得以解决问题。

为了做到这一点,我将添加一个 VBA 代码将针对的新隐藏工作表,隐藏工作表将删除我的数据集,其中所有跳过的列都被删除,以允许 VBA 从隐藏工作表中正常读取,同时从我的工作表中操作所有这些。

所需的输出将是相同的,而无需编辑 VBA 代码来为列设置异常

【讨论】:

以上是关于EXCEL VBA 将多列转换为多行,列之间有间隙的主要内容,如果未能解决你的问题,请参考以下文章

excel怎么把1行转多列多行

C#将查询返回的数据(一行多列)怎么转换成一列多行dataTable?

Oracle:多列转多行

Excel vba列表框多列多行从14个文本框

将多列合并为单列[重复]

SQL 多行多列数据清洗合并为一行