excel - EXCEL VBA 将多列转换为多行,列之间有间隙
问题描述
我有一个要转置的大型数据集,下面的代码在正确的输出中确实做到了这一点,但是列太多了。目前,代码将不断地从一列到另一列读取,直到它们全部包含在内。我想改变这个,所以我可以选择第一列数据,跳过 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
解决方案
只是为了它:
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
推荐阅读
- javascript - 从本地存储中删除项目
- javascript - 返回语句不更改全局范围内的变量
- apache-kafka - 带有 AdminClient 的 Kafka 2.1 指标
- c# - 运行 Windows Mobile 应用程序时出错
- ios - UITableView滚动时如何覆盖另一个视图
- python - 熊猫数据框切片 - 用于行 v 列顺序的 Pythonic 习语?
- ruby-on-rails - TypeError:没有将哈希隐式转换为字符串
- r - 有没有办法同时使用mice 包和gWQS 包?
- android - 如何使用每种颜色的百分比和自定义渐变角度创建可绘制的多色渐变
- jsf - JSF - selectOneMenu 中的 f:converter 和转换器标签之间的区别