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

通过第一个字母将单元格分成多个列表

1 个答案: