Ben aşağıdaki bilgileri içeren geniş bir çalışma sayfası var VBA

Question

kullanarak soldan sağa bütün bir çalışma sayfasını sıralamak mümkün mü: numaralar A sütununda altında toplanacaktır ben bir çizgi eklemek istediğiniz

1: B T B J S 

2: A 

3: T S S P E 

4: E O R P W 

aynı konumda sayıları tutarken VBA komut alfabetik tüm harfleri sıralamak için bu çalışma sayfasının tamamı düzenlemek için: Bu tabii ki, her seferinde bir satırda yapılabilir

1: B B J S T 

2: A 

3: E P S S T 

4: E O P R W 

, ama mümkün olduğu böyle bir çalışma sayfası düzenlemek için? Her satırın alfabetik olarak soldan sağa doğru sıralanacağını biliyorum, sayıları aynı pozisyonda tutacak, dolayısıyla bunu dikkate almaya gerek yok. Eksik olduğum basit bir çözüm var mı? Değiştirilmiş veya brettdj alfabetik sıralama için http://www.thespreadsheetguru.com için

Answer 1

Umut tatmin edecek

Yapmaya çalıştığınız tam olarak ne

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

Kredi: kodunun altına 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