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 回答