VBA txtファイルから数字と単語を並べ替える方法は？

Question

私はそれぞれ異なる行にある数字と単語の両方を含む.txtファイルを持っていますが、Excelの1つの列のすべての数字と他の列のすべての単語を並べ替えるVBAサブを作るにはどうすればいいですか？

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