VB(A)

알파벳과 숫자의 최대값

당근쨈 2015. 9. 1. 20:22
알파벳과 숫자의 최대값을 구하는 코드
폼으로 문서번호를 받고
문서번호에 맞는 버전을 찾아서 최대값을 구해준다.
영문과 숫자가 섞여있는 경우에는 숫자의 최대값만 출력

Private Sub CommandButton1_Click()
 
    Dim varNum() As Single
    Dim varChr() As Integer
    Dim vN As Integer
    Dim vC As Integer
    Dim wsList As Worksheet
    Dim rngList As Range
    Dim rnG As Range
    Dim maxNum As Single
    Dim maxChr As String
 
    '시트명 및 변수영역
    Set wsList = Sheets("List")
    Set rngList = wsList.Range("A1").CurrentRegion
 
    '폼에 입력한 문서번호가 있을 때 자동필터 실행
    If WorksheetFunction.CountIf(rngList.Columns(1), TextBox1) Then
        rngList.AutoFilter field:=1, Criteria1:=TextBox1
 
        '자동필터 된 영역 순환
        For Each rnG In rngList.Columns(3).SpecialCells(12)
 
            '숫자일 때
            If IsNumeric(rnG) Then
                ReDim Preserve varNum(vN)
                varNum(vN) = rnG
                vN = vN + 1
 
            '알파벳일 때
            ElseIf rnG Like "[A-Z]" Then
                ReDim Preserve varChr(vC)
                varChr(vC) = Asc(rnG)
                vC = vC + 1
            End If
        Next rnG
 
        '자동필터 해제
        wsList.ShowAllData
 
        '최대값 구하기(배열이 없을 때 에러가 나서 에러는 그냥 패스)
        On Error Resume Next
            maxNum = WorksheetFunction.Max(varNum)
            maxChr = Chr(WorksheetFunction.Max(varChr))
        On Error GoTo 0
 
        If vC = 0 Then
            TextBox2.Text = maxNum
 
        ElseIf vN = 0 Then
            TextBox2.Text = maxChr
 
        Else
            TextBox2.Text = maxNum
        End If
 
    '문서번호가 표 안에 없을 때
    Else
        TextBox2.Text = "다시"
    End If
End Sub
cs



'VB(A)' 카테고리의 다른 글

Dictionary  (0) 2015.09.12
같은 내용끼리 셀병합  (2) 2015.09.03
각 시트에서 중복된 연락처만 가져오기  (0) 2015.08.21
설정한 시간이 되면 매크로 실행  (0) 2015.08.18
셀값이 같은 행으로 정렬  (0) 2015.08.09