セルを複数のリストに最初の文字で並べ替え

Question

セルを最初の文字で分割された範囲のグループにソートするためのVBAスクリプトを作成しようとしています。言い換えれば、用語集/辞書タイプのものを書こうと思っています。単語を書いて、それを自動的にリストのセットにソートさせたいと思っています。

私はVBAスクリプトや他のプログラミング知識をほとんど経験していないため、これにはいくつか問題があります。いくつかの問題私は解決するためにここに来た：

私はより効率的にこれらの範囲を割り当てるにはどうすればよい（彼らは離れて、すべての3列です注意）これは何であるどのように私は私の配列に私がソートしたいセルを選択します

私は、私が見つけたものとできるようになりました：

Sub Sort() 
' 
' Sortme Macro 
' 
Private Sub Worksheet_Change(ByVal Target As Range) 
ColA = Range(a6, a1048576) 
ColB = Range(e6, e1048576) 
ColC = Range(h6, h1048576) 
ColD = Range(k6, k1048576) 
ColE = Range(n6, n1048576) 
ColF = Range(q6, q1048576) 
ColG = Range(t6, t1048576) 
ColH = Range(w6, w1048576) 
ColI = Range(z6, z1048576) 
ColJ = Range(ac6, ac1048576) 
ColK = Range(af6, af1048576) 
ColL = Range(ai6, ai1048576) 
ColM = Range(al6, al1048576) 
ColN = Range(ao6, ao1048576) 
ColO = Range(ar6, ar1048576) 
ColP = Range(au6, au1048576) 
ColQ = Range(ax6, ax1048576) 
ColR = Range(ba6, bb1048576) 
ColS = Range(bd6, bd1048576) 
ColT = Range(bg6, bg1048576) 
ColU = Range(bj6, bj1048576) 
ColV = Range(bm6, bm1048576) 
ColW = Range(bp6, bp1048576) 
ColX = Range(bs6, bs1048576) 
ColY = Range(bv6, bv1048576) 
ColZ = Range(by6, by1048576) 
On Error Resume Next 

ここで私はループのためのセルを選択する方法を知りたいですか？ ：

For left(range(Thiscell)) 

    If Not Intersect(Target, Range("ColA")) Is Nothing Then 
    Range(ColA).Sort Key1:=Range("A2"), _ 
     Order1:=xlAscending, _ 
     OrderCustom:=1, MatchCase:=False, _ 
     Orientation:=xlTopToBottom 
End If 
End For 

これは私がこの言語でforループをどのように終了するかですか？

End Sub 
' 
End Sub 

これは私が持っているものです。

[私のExcelシートの任意のVBA作品の前に、私は手でですべてを入力する必要が]：！[http://imgur.com/K5diRM9]

申し訳ありませんが、これは本当にない場合とにかく前もって感謝します:)

Answer 1

"Dictionary"という名前のシートのA1に単語を入力します。次に、このマクロを実行します。単語を正しいアルファベット順の列に入れ、必要に応じてその列をソートします。言葉は6行目から始まります。これは、あなたがそれらを始めると思うところです。入力ボックスから単語f4を受け入れるように調整するか、別のワークシートの列から単語のリストを追加することができます。

Sub putWordInAlphebeticalColumn() 

Dim columnArr, wordToAlphebetize As String, lastUsedRw As Long 
Dim i As Integer, isAlpha As Boolean, firstLetter As String 
Dim colNumber As Integer 

columnArr = Array("A", "B", "C", "D", "E", "F", "G", _ 
         "H", "I", "J", "K", "L", "M", "N", _ 
         "O", "P", "Q", "R", "S", "T", "U", _ 
         "V", "W", "X", "Y", "Z") 


wordToAlphebetize = Sheets("Dictionary").Range("A1").Value 

If Len(wordToAlphebetize) > 0 Then ' Determine if string is all alpha characters 
    For i = 1 To Len(Trim(wordToAlphebetize)) 
      Select Case Asc(Mid(wordToAlphebetize, i, 1)) 
       Case 65 To 90, 97 To 122 
        isAlpha = True 
       Case Else 
        If i > 1 And Mid(Trim(wordToAlphebetize), i, 1) = "-" Then 
         isAlpha = True 
        Else 
         isAlpha = False 
         MsgBox "Word contains non-alpha character(s)" 
         Sheets("Dictionary").Range("A1").Value = "" 
         Exit Sub 
        End If 
      End Select 
    Next i 
End If 


firstLetter = Mid(wordToAlphebetize, 1, 1) 

For i = 0 To 26 
    If UCase(firstLetter) = columnArr(i) Then 
     colNumber = i 
     Exit For 
    End If 
Next i 


lastUsedRw = Sheets("Dictionary").Range(columnArr(colNumber) & Rows.Count).End(xlUp).Row 

With Sheets("Dictionary").Range(columnArr(colNumber) & "6:" & columnArr(colNumber) & lastUsedRw + 6) 
    Set c = .Find(LCase(wordToAlphebetize), LookIn:=xlValues) 
    If Not c Is Nothing Then 
     MsgBox "Word already exists" 
     Sheets("Dictionary").Range("A1").Value = "" 
     Exit Sub 
    Else 
     If Sheets("Dictionary").Range(columnArr(colNumber) & "6").Value = "" Then 
      Sheets("Dictionary").Range(columnArr(colNumber) & "6").Value = wordToAlphebetize 
     Else 
      Sheets("Dictionary").Range(columnArr(colNumber) & lastUsedRw + 1).Value = wordToAlphebetize 
     End If 
     lastUsedRw = Sheets("Dictionary").Range(columnArr(colNumber) & Rows.Count).End(xlUp).Row 
     If lastUsedRw > 6 Then 
      Range(columnArr(colNumber) & "6:" & columnArr(colNumber) & lastUsedRw).Select 
      Worksheets("Dictionary").Sort.SortFields.Clear 
      Worksheets("Dictionary").Sort.SortFields.Add Key:=Range(columnArr(colNumber) & "6") _ 
       , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 
      With Worksheets("Dictionary").Sort 
       .SetRange Range(columnArr(colNumber) & "6:" & columnArr(colNumber) & lastUsedRw) 
       .Header = xlGuess 
       .MatchCase = False 
       .Orientation = xlTopToBottom 
       .SortMethod = xlPinYin 
       .Apply 
      End With 
     End If 

    End If 
End With 


End Sub