Ist es möglich, ein gesamtes Arbeitsblatt von links nach rechts mit VBA

Question

Ich habe ein großes Arbeitsblatt mit den folgenden Informationen zu sortieren:

1: B T B J S 

2: A 

3: T S S P E 

4: E O R P W 

Wo die Zahlen fallen alle in Spalte A. mich eine Linie enthalten sein soll in ein VBA-Skript das gesamte Arbeitsblatt zu ordnen all Buchstaben in alphabetischer Reihenfolge zu sortieren, während die Zahlen in der gleichen Position zu halten:

1: B B J S T 

2: A 

3: E P S S T 

4: E O P R W 

Dies auf einer Linie durchgeführt in einer Zeit, natürlich werden kann, aber ist es möglich, ein ganzes Arbeitsblatt so zu arrangieren? Ich weiß, dass jede Zeile, die alphabetisch von links nach rechts sortiert wird, die Zahlen in der gleichen Position behält, also muss man das nicht berücksichtigen. Gibt es eine einfache Lösung, die ich vermisse?

Answer 1

Hoffnung unter Code erfüllen

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

Credit http://www.thespreadsheetguru.com für die alphabetische Sortierung I geändert und brettdj: 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