将数据重新格式化为另一个Excel工作表

Question

我正在为文件夹中的许多文本文件进行主题建模。我已将最终综合文本文件中的数据导入excel。它的格式如下。整数表示主题，小数表示该主题在该文本文件中的百分比。

  

| C | | D | | E | | F | |   G | | H | |我| | Ĵ   |
| 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方法，但看起来我必须硬编码那里的值。还有另一种方法吗？

以下是我的源数据：

Source Data in 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

Answer 1

• 首先，它获取源表（活动表）的源范围中的最高主题。

• 然后在源范围内搜索每个主题编号，找到后将邻居复制到新工作表

  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