2017-02-02 1 views
0

첫 번째 문자로 분할 된 범위 그룹으로 셀을 정렬하는 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 루프는 어떻게이 언어로 끝나나요? 이건 정말하지 않는 경우 [http://imgur.com/K5diRM9]

죄송합니다!

[내 엑셀 어떤 VBA를 작동하기 전에 시트와 나는 손으로 모든 것을 입력해야] :

End Sub 
' 
End Sub 

내가 무엇을 가지고 어쨌든 사전에 감사드립니다.

+0

왜 워크 시트 변경 이벤트입니까? 'Range (a6, a1048576)'실제로 작동합니까? (보통 대회는'Range ("A6 : A1048576")'입니다. 매크로로 무엇을하려고합니까? VBA에서'End Sub'는 서브 루틴의 끝입니다 .' for' 루프를 사용하면 'For i = 1 to 10'과 같은 일을하고 다음 i로 반복 할 next i를 입력하면됩니다. – BruceWayne

+0

명확한 점은 주어진 셀에 입력 된 단어를 첫 번째 문자를 선택한 다음 해당 열을 내림차순으로 정렬합니까? –

답변

0

"사전"이라는 시트의 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 
관련 문제