Selasa, 16 Februari 2016

RE: [MS_AccessPros] OFF TOPIC: MS Excel VBA code

 

Sub ScrabbleSort()

'

' ScrabbleSort Macro

' sorting letters in a word alphabetically

'

 

Dim lastrow As Long

Dim i As Long

 

    Application.ScreenUpdating = False

   

    With ActiveWorkbook.Worksheets("Sheet3")

   

        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row

        For i = 2 To lastrow

       

            .Sort.SortFields.Clear

            .Sort.SortFields.Add Key:=.Cells(i, "A").Resize(, 15), _

                                 SortOn:=xlSortOnValues, _

                                 Order:=xlAscending, _

                                 DataOption:=xlSortNormal

            .Sort.SetRange .Cells(i, "A").Resize(, 15)

            .Sort.Header = xlGuess

            .Sort.MatchCase = False

            .Sort.Orientation = xlLeftToRight

            .Sort.SortMethod = xlPinYin

            .Sort.Apply

        Next i

    End With

 

    Application.ScreenUpdating = True

End Sub

 

From: MS_Access_Professionals@yahoogroups.com [mailto:MS_Access_Professionals@yahoogroups.com]
Sent: 16 February 2016 03:12
To: MS_Access_Professionals@yahoogroups.com
Subject: [MS_AccessPros] OFF TOPIC: MS Excel VBA code

 

 


I could not find the yahoo MS Excel group email so I am posting here.

I grabbed a list of dictionary words, from 2 to 15 letters long. Each word gets its own row in Excel. Each letter of each word gets its own column in Excel (I parsed the words out via text to columns). Since these words can be up to 15 letters in length that means it is possible to go out to column O in Excel.

I want to take each word in each row and turn it into its "alphagram"
An alphagram is putting each word's letters in alphabetical sort order.
For instance, AARDVARK, would be sorted to AAADKRRV

I have the following VBA code, but it would be real tedious to repeat the same code for each and row up to 187,633 rows of words plus one header row, hence why code starts at row 2.

Is there an easier way? Code is below:

Thank you in advance for any help you can give.

Eric Lutz
---------------------------------------------------

Sub ScrabbleSort()
'
' ScrabbleSort Macro
' sorting letters in a word alphabetically
'

'
Rows("2:2").Select
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Add Key:=Range("A2:O2"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet3").Sort
.SetRange Range("A2:O2")
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlPinYin
.Apply
End With
Rows("3:3").Select
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Add Key:=Range("A3:O3"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet3").Sort
.SetRange Range("A3:O3")
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlPinYin
.Apply
End With
Rows("4:4").Select
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Add Key:=Range("A4:O4"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet3").Sort
.SetRange Range("A4:O4")
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlPinYin
.Apply
End With
Rows("5:5").Select
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Add Key:=Range("A5:O5"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet3").Sort
.SetRange Range("A5:O5")
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlPinYin
.Apply
End With
Rows("6:6").Select
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Add Key:=Range("A6:O6"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet3").Sort
.SetRange Range("A6:O6")
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlPinYin
.Apply
End With
Rows("7:7").Select
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Add Key:=Range("A7:O7"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet3").Sort
.SetRange Range("A7:O7")
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlPinYin
.Apply
End With
Rows("8:8").Select
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Add Key:=Range("A8:O8"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet3").Sort
.SetRange Range("A8:O8")
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlPinYin
.Apply
End With
Rows("9:9").Select
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Add Key:=Range("A9:O9"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet3").Sort
.SetRange Range("A9:O9")
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlPinYin
.Apply
End With
Rows("10:10").Select
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Add Key:=Range("A10:O10") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet3").Sort
.SetRange Range("A10:O10")
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlPinYin
.Apply
End With
Rows("11:11").Select
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Add Key:=Range("A11:O11") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet3").Sort
.SetRange Range("A11:O11")
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlPinYin
.Apply
End With
Rows("12:12").Select
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Add Key:=Range("A12:O12") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet3").Sort
.SetRange Range("A12:O12")
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlPinYin
.Apply
End With
Rows("13:13").Select
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Add Key:=Range("A13:O13") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet3").Sort
.SetRange Range("A13:O13")
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlPinYin
.Apply
End With
Rows("14:14").Select
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Add Key:=Range("A14:O14") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet3").Sort
.SetRange Range("A14:O14")
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlPinYin
.Apply
End With
Rows("15:15").Select
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Add Key:=Range("A15:O15") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet3").Sort
.SetRange Range("A15:O15")
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlPinYin
.Apply
End With
Rows("16:16").Select
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Add Key:=Range("A16:O16") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet3").Sort
.SetRange Range("A16:O16")
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlPinYin
.Apply
End With
Rows("17:17").Select
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Add Key:=Range("A17:O17") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet3").Sort
.SetRange Range("A17:O17")
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlPinYin
.Apply
End With
End Sub

__._,_.___
Posted by: "Bob Phillips" <bob.phillips@dsl.pipex.com>
Reply via web post • Reply to sender • Reply to group • Start a New Topic • Messages in this topic (4)

.

__,_._,___
Diposting oleh di

Tidak ada komentar:

Posting Komentar

Langganan: Posting Komentar (Atom)