Question

我有一个.txt文件，其中包含不同行中的数字和单词，如何创建一个VBA sub，它将对excel中一列中的所有数字和另一列中的所有单词进行排序？< / p>

The image of the txt file and how the Excel should look in the result

我无法解决这个问题，但我无法在任何论坛上找到它。

谢谢。

Answer 1

这是您的解决方案

Option Explicit

Private Const msSORT_SHEET As String = "____Sort"

Sub TestReadFile()
    Dim vNumbersArray As Variant, vWordsAtray As Variant

    '* change filename below
    Call ReadFile("n:\Unjumble Words And numbers.txt", vNumbersArray, vWordsAtray)


    Dim vSortedNumberArray As Variant
    vSortedNumberArray = SortVector(vNumbersArray)

    Dim vSortedWordsArray As Variant
    vSortedWordsArray = SortVector(vWordsAtray)



End Sub


Function SortVector(ByVal vVector As Variant) As Variant
    Dim wsSort As Excel.Worksheet
    Set wsSort = AddOrFindSortSheet

    On Error Resume Next
    Dim lRowCount As Long
    lRowCount = UBound(vVector) - LBound(vVector) + 1
    On Error GoTo 0

    If lRowCount > 2 Then

        wsSort.Cells.Clear

        Dim rng1 As Excel.Range
        Set rng1 = wsSort.Range(wsSort.Cells(1, 1), wsSort.Cells(1, lRowCount))
        rng1.Value2 = vVector

        Dim v2d As Variant
        v2d = rng1.Value2

        Dim vTranspose As Variant
        vTranspose = Application.Transpose(v2d)

        wsSort.Cells.Clear

        Dim rngSort As Excel.Range
        Set rngSort = wsSort.Range(wsSort.Cells(1, 1), wsSort.Cells(lRowCount, 1))
        rngSort.Value2 = vTranspose

        wsSort.Sort.SortFields.Clear
        wsSort.Sort.SortFields.Add Key:=rngSort _
            , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With wsSort.Sort
            .SetRange rngSort
            .Header = xlGuess
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With

        Dim vSorted As Variant
        vSorted = rngSort.Value2

        SortVector = vSorted

    End If

End Function

Function AddOrFindSortSheet() As Excel.Worksheet

    Dim wsSort As Excel.Worksheet
    Set wsSort = FindSortSheet

    If wsSort Is Nothing Then
        Set wsSort = AddSortSheet
    End If

    Set AddOrFindSortSheet = wsSort
End Function

Function AddSortSheet() As Excel.Worksheet
    Dim wsAdded As Excel.Worksheet
    Set wsAdded = ThisWorkbook.Worksheets.Add
    wsAdded.Name = msSORT_SHEET
    wsAdded.Visible = xlSheetHidden
End Function

Function FindSortSheet() As Excel.Worksheet
    Dim wsLoop As Excel.Worksheet
    For Each wsLoop In ThisWorkbook.Worksheets
        If wsLoop.Name = msSORT_SHEET Then
            Set FindSortSheet = wsLoop
        End If
    Next

End Function

Sub ReadFile(ByVal sFilename As String, ByRef pvNumbersArray As Variant, ByRef pvWordsAtray As Variant)

    Dim fso As Scripting.FileSystemObject
    Set fso = New Scripting.FileSystemObject

    Debug.Assert fso.FileExists(sFilename)

    Dim txt  As Scripting.TextStream
    Set txt = fso.OpenTextFile(sFilename)

    Dim sLine As String

    Dim dicNumbers As New Scripting.Dictionary
    Dim dicText As New Scripting.Dictionary

    While Not txt.AtEndOfStream
        sLine = txt.ReadLine
        If Len(sLine) > 0 Then
            Debug.Print sLine
            If IsNumeric(sLine) Then
                dicNumbers.Add dicNumbers.Count, CDbl(sLine)
            Else
                dicText.Add dicText.Count, sLine
            End If

        End If
    Wend

    pvNumbersArray = dicNumbers.Items

    pvWordsAtray = dicText.Items

End Sub

VBA如何从txt文件中对数字和单词进行排序？

1 个答案: