将数据重新格式化到另一个Excel工作表中
我正在为文件夹中的多个文本文件进行主题build模。 我已经从最终的综合文本文件导入到Excel中的数据。 它的格式如下。 整个数字表示主题，小数表示该文本文件中发生该主题的百分比。
| C | | D | | E | | F | | G | | H | | 我| | J |
| 2 | | 0.85 | | 1 | | 0.05 | | 0 | | 0.012 | | 3 | | 0.004 | ….
| 0 | | 0.50 | | 2 | | 0.31 | | 3 | | 0.146 | | 1 | | 0.068 | …
主题编号需要成为列标题，百分比在下面。 我需要将数据按以下格式重新格式化为另一个表格：
| D | | E | | F | | G |
| 0 | | 1 | | 2 | | 3 | … | n |
| 0.012 | | 0.05 | | 0.85 | | 0.004 |
| 0.50 | | 0.068 | | 0.31 | | 0.146 |
每个文本文件将具有相同的主题数量，但主题数量可能会有所不同。 所以，这个例子有4个主题，但另一个可能有20,25等。我尝试使用items方法，但它看起来像我将不得不硬编码在那里的值。 有没有另外一种方法来做到这一点？
以下是我的源数据的样子：
Excel中的源数据
我试过，但一直卡住：
Sub Items_Ex() Dim myColumn As Long myRow = 2 While Worksheets("Input_Format_A").Cells(2, myColumn).Value <> "" Dim myRow As Long myRow = 3 While Worksheets("Input_Format_A").Cells(myRow, 3).Value <> "" Dim d As Dictionary Dim a, i 'Create some variables Set d = New Dictionary d.Add "1", Worksheets("Input_Text").Cells(1, 8).Value d.Add "2", Worksheets("Input_Text").Cells(1, 6).Value d.Add "3", Worksheets("Input_Text").Cells(1, 4).Value 'Do until there are no more topics a = d.Items 'Get the items For i = 0 To d.Count - 1 'Iterate the array Debug.Print a(i) 'Print item Next Debug.Print d.Item("b") myRow = myRow + 1 Wend Wend End Sub - 首先它在源表单（源表单） 的源范围中获得最高的主题 。
-
然后在源范围内search每个主题编号，当find时则将邻居复制到新工作表
Private Const NEW_SHEET_NAME As String = "NewSheetName" Private Const FIRST_TARGET_ROW = 9 Private Const FIRST_TARGET_COLUMN = 4 Private Const FIRST_SOURCE_CELL As String = "c2" Sub test() Dim sourceSheet As Worksheet Set sourceSheet = ActiveSheet If (sourceSheet.UsedRange Is Nothing) Then Exit Sub Dim sourceRange As Range Set sourceRange = Application.Intersect(sourceSheet.UsedRange, sourceSheet.Range(FIRST_SOURCE_CELL & ":" & sourceSheet.UsedRange.Cells.SpecialCells(xlCellTypeLastCell).Address)) Dim maxTopic As Byte maxTopic = CByte(Application.WorksheetFunction.Max(sourceRange)) Dim data() As Variant data = sourceRange.Value Dim newSheet As Worksheet Set newSheet = ThisWorkbook.Worksheets.Add newSheet.Name = NEW_SHEET_NAME Dim topic As Byte Dim i As Integer Dim j As Integer Dim item As Variant For topic = 0 To maxTopic newSheet.Cells(FIRST_TARGET_ROW, FIRST_TARGET_COLUMN + topic).Value = topic For i = LBound(data, 1) To UBound(data, 1) For j = LBound(data, 2) To UBound(data, 2) item = data(i, j) If (IsEmpty(item)) Then GoTo next_item If (item = topic) Then With newSheet If (j + 1 <= UBound(data, 2)) Then .Cells(.Cells(.Rows.Count, FIRST_TARGET_COLUMN + topic).End(xlUp).Row + 1, FIRST_TARGET_COLUMN + topic).Value = data(i, j + 1) End If End With End If next_item: Next j Next i Next topic End Sub