我有一个格式如下的Excel电子表格:
我一直试图将其格式化为:
所以我想这是一种转置(不知道怎么称呼它)。
我花了最后一个半小时试图在VBA中做到这一点并没有成功。
这只是一个如何格式化的示例,实际上大约有50,000个,所以我需要使用VBA或类似的东西来做。
有人能帮我解决这个问题吗?
答案 0 :(得分:3)
使用Excel 2007,您不一定需要VBA。在数据透视表向导(Alt + D,P)中选择“多个合并范围”,然后选择“我将创建页面字段”,接下来,选择您的数据,接下来,选择“新工作表”,完成。双击数据透视表的底部RH单元格。过滤ColumnA并删除空行,过滤ColumnB并删除包含“Type”的行。在“Row”和“Column”右侧插入列并填充查找值。
答案 1 :(得分:1)
如果你对LOOKUP不太满意并且有一个可管理的范围,那么有一种替代方案会更加乏味,但如果再次需要这种“换位”并且你已经忘记了确切的方式,可能会更容易记住! / p>
答案 2 :(得分:0)
你能不能只复制和粘贴专用并选择转置?
实际上再看一下OP这不是一个直接的转置,因为你的第二个丝网印刷中的前两列不是直接转置。
最终编辑
好的 - 似乎有用......
Option Base 1
Sub moveData()
Dim NumIterations As Integer
NumIterations = ThisWorkbook.Sheets("target").Cells(Rows.Count, 3).End(xlUp).Row - 2
'get the raw data and add to an array
Dim n As Long
Dim m As Long
Dim myArray() As Long
ReDim myArray(1 To NumIterations, 1 To 3)
For n = 1 To NumIterations
For m = 1 To 3
myArray(n, m) = ThisWorkbook.Sheets("target").Cells(n + 2, m + 2)
Next m
Next n
Dim q As Long
Dim r As Long
Dim myStaticArray()
ReDim myStaticArray(1 To NumIterations, 1 To 2)
For q = 1 To NumIterations
For r = 1 To 2
myStaticArray(q, r) = ThisWorkbook.Sheets("target").Cells(q + 2, r)
Next r
Next q
'spit the data back out
Dim i As Long
Dim j As Long
Dim myRow As Long
myRow = 0
For i = 1 To NumIterations
For j = 1 To 3
myRow = myRow + 1
ThisWorkbook.Sheets("answer").Cells(myRow, 1) = myStaticArray(i, 1)
ThisWorkbook.Sheets("answer").Cells(myRow, 2) = myStaticArray(i, 2)
If j = 1 Then
ThisWorkbook.Sheets("answer").Cells(myRow, 3) = "r1"
ThisWorkbook.Sheets("answer").Cells(myRow, 4) = "11-000 - 13-000"
ElseIf j = 2 Then
ThisWorkbook.Sheets("answer").Cells(myRow, 3) = "r2"
ThisWorkbook.Sheets("answer").Cells(myRow, 4) = "15-000 - 30-000"
ElseIf j = 3 Then
ThisWorkbook.Sheets("answer").Cells(myRow, 3) = "r3"
ThisWorkbook.Sheets("answer").Cells(myRow, 4) = "31-000"
End If
ThisWorkbook.Sheets("answer").Cells(myRow, 5) = myArray(i, j)
Next j
Next i
End Sub
答案 3 :(得分:0)
您可以使用PasteSpecial执行此操作,如下所示
Sheet(1).UsedRange.Select
Selection.Copy
ActiveWorkbook.Sheets.Add 'Make some room for pasting the cells in the new format
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Application.CutCopyMode = False