0

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

| C | | D | | E | | F | | 克| | 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 | | 克|
| 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
4

1 回答 1

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

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

    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
于 2013-03-02T09:26:21.363 回答