0

フォルダー内の多数のテキスト ファイルのトピック モデリングを行っています。最終的な包括的なテキスト ファイルから Excel にデータをインポートしました。以下のような形になっています。整数はトピックを表し、小数はそのトピックの何パーセントがそのテキスト ファイルで発生したかを表します。

| | シー | | | D | | | え | | | ふ | | | ガ | | | ひ | | | 私 | 私 | | | 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 | | | え | | | ふ | | | ガ |
| | 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 に答える