は、私は、以下の情報を持つ大規模なワークシートを持っているVBA

Question

を使用して、左から右にワークシート全体をソートすることは可能です：数字列Aにすべての秋、私は内の行を含める

1: B T B J S 

2: A 

3: T S S P E 

4: E O R P W 

1: B B J S T 

2: A 

3: E P S S T 

4: E O P R W 

これはもちろん、一度に一つのライン上で行うことができますが、それが可能である：同じ位置に数字を維持しながら、アルファベット順にすべての文字を並べ替えるために、このワークシート全体を配置するVBAスクリプトこのようなワークシート全体を手配しますか？私は各行がアルファベット順に左から右にソートされていることを知っているので、同じ位置に番号を保持するので、考慮する必要はありません。私は行方不明の簡単な解決策はありますか？私は修正してbrettdjするアルファベット順の並べ替えのためのhttp://www.thespreadsheetguru.comへ

Answer 1

コード以下の希望は、あなたが何をしようとしている正確に何

Sub Sort() 
lastrow = Range("A" & Rows.Count).End(xlUp).Row 
For i = 1 To lastrow 
    lastcolumn = Cells(i, Columns.Count).End(xlToLeft).Column 
    ReDim sortalphabet(lastcolumn - 2) As String 
    For j = 2 To lastcolumn 
     sortalphabet(j - 2) = Cells(i, j) 
    Next j 
    For ii = LBound(sortalphabet) To UBound(sortalphabet) - 1 
     For j = LBound(sortalphabet) To UBound(sortalphabet) - 1 
      If ii < UBound(sortalphabet) Then 
       Condition1 = sortalphabet(j) > sortalphabet(j + 1) 
       If Condition1 Then 
        t = sortalphabet(j) 
        sortalphabet(j) = sortalphabet(j + 1) 
        sortalphabet(j + 1) = t 
       End If 
      End If 
     Next j 
    Next ii 
    For j = 2 To lastcolumn 
     Cells(i, j) = sortalphabet(j - 2) 
    Next j 
Next i 
End Sub 

Answer 2

クレジット：VBA Exclude special characters and numbers but keep spaces from string

Sub sortcells(StartRange As Range) 

    Dim strArrCell() As String 
    Dim intTemp As Integer 

    Do While rngStart.Value <> "" 
     intTemp = Split(StartRange.Value, ":")(0) 
     strArrCell = Split(StripNonAlpha(rngStart.Value), " ") 
     strArrCell = Alphabetically_SortArray(strArrCell) 
     StartRange.Value = intTemp & ": " & Join$(strArrCell, " ") 
     Set StartRange = StartRange.Offset(1, 0) 
    Loop 

End Sub 

Function Alphabetically_SortArray(myArray() As String) As String() 

    Dim x As Long, y As Long 
    Dim TempTxt1 As String 
    Dim TempTxt2 As String 

    For x = LBound(myArray) To UBound(myArray) 
     For y = x To UBound(myArray) 
     If UCase(myArray(y)) < UCase(myArray(x)) Then 
      TempTxt1 = myArray(x) 
      TempTxt2 = myArray(y) 
      myArray(x) = TempTxt2 
      myArray(y) = TempTxt1 
     End If 
     Next y 
    Next x 

    Alphabetically_SortArray = myArray 

End Function 

Function StripNonAlpha(TextToReplace As String) As String 
    Dim ObjRegex As Object 
    Set ObjRegex = CreateObject("vbscript.regexp") 
    With ObjRegex 
     .Global = True 
     .Pattern = "[^a-zA-Z\s]+" 
     StripNonAlpha = .Replace(Replace(TextToReplace, "-", Chr(32)), vbNullString) 
    End With 
End Function