도움되는 블로그

예제13.xlsm

Cells(3, 3).Borders(xlEdgeLeft).LineStyle = xlContinuous    '셀의 왼쪽 테두리 설정

Cells(3, 3).Borders(xlEdgeRight).LineStyle = xlContinuous    '셀의 오른쪽 테두리 설정

Cells(3, 3).Borders(xlEdgeTop).LineStyle = xlContinuous    '셀의 위쪽 테두리 설정

Cells(3, 3).Borders(xlEdgeBottom).LineStyle = xlContinuous    '셀의 아래쪽 테두리 설정

Cells(3, 3).Borders(xlEdgeLeft).Weight = xlThin

Cells(3, 3).Borders(xlEdgeRight).Weight = xlThin

Cells(3, 3).Borders(xlEdgeTop).Weight = xlMedium

Cells(3, 3).Borders(xlEdgeBottom).Weight = xlThick

Cells(4, 3).Interior.Color = vbRed

Cells(4, 3).Interior.Color = RGB(111, 222, 50)

Cells(3, 4).Font.Size = 8        '폰트 크기(글자 크기) 설정 

Cells(4, 4).Font.Bold = True        '폰트 볼드체로 바꾸기 True/False

Cells(5, 4).Font.Name = "궁서체"    '폰트 바꾸기

Cells(6, 4).Font.Italic = True        '폰트 이탤릭체(기울임꼴) 바꾸기 True/False

Cells(7, 4).Font.Underline = True        '폰트에 밑줄 긋기 True/False

이전 포스팅 바로가기

[엑셀 VBA 예제4] 기간별(날짜별) 합계 구하기

실전예제5.xlsm

Private Sub worksheet_change(ByVal Target As Range)

Dim i As Integer

Dim n As Integer

Dim m As Integer

If Not Intersect(Range("c2:c9"), Target) Is Nothing Then

'----------------------여기부터 범위가 1보다 클 경우

If Target.Count > 1 Then            '타겟의 범위가 1보다 크다면(바뀌는 값의 범위가 한개가 아니라면)

n =  Target.Row                    '값을 수정하는 범위의 첫 행 (가장 윗행)

m = n + Target.Count - 1            '값을 수정하는 범위의 마지막 행(첫 행 + 범위 크기 - 1)

For i = n To m                            '범위의 첫 행부터 마지막 행까지 반복

    Select Case Cells(i, 3).Value            '셀의 값을 조건으로 한 조건문

    Case 0                                        '값이 0이라면(없다면)

    Cells(i, 3).Interior.color = xlNone        '셀을 투명하게(초기화)

    Case Is < 300000                            '값이 300000보다 작다면

    Cells(i, 3).Interior.color = RGB(255, 0, 0)        'red 색상으로 변경

    Case 300000 To 10000000                '값이 300000과 10000000 사이라면

    Cells(i, 3).Interior.color = RGB(0, 255, 0)        'green 색상으로 변경

    Case Is > 10000000                        '값이 10000000보다 크다면

    Cells(i, 3).Interior.color = RGB(0, 0, 255)        'blue 색상으로 변경

    End Select

Next i                    '다음 셀에서 반복

Exit Sub                '프로시져 종료

else

End If

'-------------------------여기까지 범위가 1보다 클 경우

'-------------------------여기부터 범위가 1일경우(한개의 셀만 수정할 경우)

    Select Case Target

        Case 0

        Target.Interior.color = xlNone

        Case Is < 300000

        Target.Interior.color = RGB(255, 0, 0)

        Case 300000 To 10000000

        Target.Interior.color = RGB(0, 255, 0)

        Case Is > 10000000

        Target.Interior.color = RGB(0, 0, 255)

    End Select

End If

End Sub

실전예제4.xlsm

Sub example()

Dim sumdata()                '값을 넣을 배열 추가

Dim nrow As Long            '시작하는 셀의 행

Dim ncol As Long                '시작하는 셀의 열

Dim lastD As String             

Dim i As Integer   

Dim D as string

    nrow = 2                '시작하는 셀의 행

    ncol = 1                '시작하는 셀의 열

    i = 1                    '카운터(배열의 행을 추가하기 위한)

    lastD = Left(Cells(nrow, ncol).Value, 7)        '날짜 중복을 방지하기 위한 설정

        For nrow = 2 To Cells(2, 1).End(4).Row        '시작행 2부터 값이 있는 마지막 셀까지 반복

        D = Cells(nrow, ncol).Value         '날짜 값 변수에 넣기               

            If D <> lastD Then                '이전 날짜 값과 같지 않다면

            i = i + 1                            '카운터에 1을 더한다

            End If

                ReDim Preserve sumdata(1 To 2, 1 To i)    '배열 재선언(카운터만큼 열을 늘린다)

                sumdata(1, i) = D                '날짜값을 배열의 첫 값에 넣음

                sumdata(2, i) = sumdata(2, i) + Cells(nrow, ncol).Offset(0, 1)   '누적되는 액수를 두번째 칸에 넣음

                lastD = D                'lastD값 재생성

        Next nrow             '날짜가 변할때 까지 액수 누적 반복       

    Cells(1, 4).Resize(2, i) = sumdata        '배열을 셀에 집어넣기

End Sub

Int(Rnd * 정수 최대값) + 1

Sub example_12()

Dim lotto(1 To 7) As Integer

Dim i As Integer

Dim a As Integer

Dim ii As Integer

Dim n As Integer

Dim m As Integer

Dim sorttemp As Integer

i = 1                

For i = 1 To 7                    '로또 번호가 7개이기 때문에 7번 반복해서 난수 추출

restart:

Randomize                        '난수 재생성

   a = Int(Rnd * 50) + 1        '난수 a 생성(1~50)

lotto(i) = a                        'lotto배열의 각 항에 난수값 입력

            For ii = LBound(lotto) To (i - 1)        '첫 난수부터 지금 추출된 난수의 전값(i - 1)까지 반복

                Select Case lotto(ii)             '즉 lotto배열의 마지막 값(지금 추출한 난수)과 이전 난수를 반복 비교

                    Case lotto(i)

                  GoTo restart                    'lotto(ii) 이전 난수값과 lotto(i) 지금 추출한 난수값이 같으면 restart로 이동

                End Select

            Next ii                    '여기까지 중복값 배제하는 코드

Next i

'여기부터 난수 오름차순 정렬(버블정렬) 이해가 안가면 전강의 보세요.

'정렬이 필요가 없다면 아래 For~Next 부분은 전부 삭제해도 무방합니다.

For n = 1 To UBound(lotto) - 1            

    For m = 1 To UBound(lotto) - n

        If lotto(m) > lotto(m + 1) Then

            sorttemp = lotto(m + 1)

            lotto(m + 1) = lotto(m)

            lotto(m) = sorttemp

        End If

    Next m

Next n                                                '버블정렬 종료

Cells(3, 1).Resize(, UBound(lotto)) = lotto        '세로1 가로7의 배열을 셀에 입력

End Sub

이전 포스팅 바로가기

배열 관련 포스팅 바로가기

예제11.xlsm

Sub example_11()

Dim score()                '점수 배열 선언

Dim sortemp as integer        '바뀌는 대상을 임시로 저장하는 변수   

Dim maxval As Long            '총 항 개수를 구하기 위한 변수

Dim n As Long                   

Dim m As Long

     maxval = Cells(2, 2).End(4).Row - 1        '점수 총 개수를 구함

   ReDim score(1 To maxval)                '점수의 개수에 맞춰서 배열 재선언

    score = Application.Transpose(Cells(2, 2).Resize(maxval, 1).Value)        '값을 score 배열에 집어넣음

'Application.Transpose는 열을 행으로(또는 반대로) 바꿔주는 함수. 1차배열은 우로 나열되기 때문에 위치를 바꿔준다

For n = 1 To UBound(score) - 1        '첫번 째 행부터 몇번 반복되야하는지 설정 총 100개라면 99번 반복

    For m = 1 To UBound(score) - n            '배열의 개수만큼 반복하는 반복문

        If score(m) < score(m + 1) Then        'm번째 항이 m + 1번째 항보다 작다면

            SortTemp = score(m + 1)            '임시저장변수에 m + 1 항의 값을 넣고

            score(m + 1) = score(m)            'm 항의 값을 m + 1 항에 넣는다

            score(m) = SortTemp                'm 항에는 임시저장변수에 저장되있던 m + 1항의 원래값을 넣는다

'(결국 m과 m + 1 항의 값이 바뀜)

        End If

    Next m

Next n

Cells(2, 3).Resize(maxval, 1) = Application.Transpose(score)            '옆 열에 정렬된 배열을 삽입.

End Sub

예제10.xlsm

Private Sub worksheet_change(ByVal Target As Range)

If Not Intersect(범위, Target) Is Nothing Then

...

...

End If

End Sub

Target은?

ByVal은?

Intersect는?

Private Sub worksheet_change(ByVal Target As Range)

If Not Intersect(Range("b2"), Target) Is Nothing Then  '변경되는 셀과 B2셀의 교집합. 즉, B2셀에서만 프로시저 발동

        Select Case Len(Target)        '변경되는 셀의 문자 길이값을 조건으로 설정

            Case 8, 0                '문자 길이값이 8 혹은 0일때 (8은 정확히 입력된 경우, 0은 아무것도 없을 경우)

            Exit Sub                 '프로시저 종료

            Case Else                '8과 0을 제외한 다른 값일 경우

            MsgBox "yyyymmdd 형식으로 정확히 입력하세요." 

            Target.Clear            '값 초기화

            End Select

    End If

End Sub

Private Sub worksheet_change(ByVal Target As Range)

If Not Intersect(Range("b1"), Target) Is Nothing Then

    With Target

        .Font.Name = "맑은 고딕"

        .Font.Size = 15

        .Font.Bold = True

    End With

End If

End sub

Private Sub worksheet_change(ByVal Target As Range)

If Not Intersect(Range("B4:B19"), Target) Is Nothing Then

    Sheet13.Cells(3, 2).Value = Application.WorksheetFunction.Sum(Range("B4:B19"))

    End If

End Sub

Public Function colorsum(rngcolor, rng As Range)   '함수 이름은 colorsum, 인수는 '지정색깔(rngcolor)', '합계범위(rng)'

Dim sum As Long  '구할 합계 sum 변수설정

Dim SearchColor as Long  '색깔 변수 설정

sum = 0  '합계 초기값 설정

SearchColor = rngcolor.Interior.color    '첫 번째 인수인 rngcolor에 지정된 셀의 색깔값을 SearchColor에 지정

For Each rngn In rng        '두 번째 인수인 rng의 범위 안에서 처음부터 끝까지 순환

If rngn.Interior.color = SearchColor Then    '해당 셀의 색깔이 rngcolor의 색깔과 같다면

sum = sum + rngn.Value            '합계에 해당 값을 더한다

End If

Next                '그 다음 셀으로 이동

colorsum = sum            '출력할 함수값 지정

End Function

이전 포스팅 바로가기

[엑셀 VBA #13] (배열#2) 배열의 크기 확인 Ubound, Lbound

예제9.xlsm

김정기 윤주환 정문석 고정우 김진기 정윤환

문자가 나눠지는 부분이 일정한 구분자(공백(space bar), 콤마(,), 슬래시(/)) 등으로 나눠져 있어야 합니다.

Sub example_9()

Dim varName() As String        '배열 varName 선언, 형식 에러가 날 경우 As Variant로 변경

Dim i As Long

i = UBound(Split(Cells(3, 1), " ")) - LBound(Split(Cells(3, 1), " ")) + 1    '문자의 개수 확인

ReDim varName(1 To i)            '문자의 개수만큼 배열 크기 설정

varName = Split(Cells(3, 1), " ")            '공백을 기준으로 문자열 나눔 "vbTab" "," ";" 등 여러가지 사용 가능 

Selection.Resize(, i).Value = varName    '선택한 셀을 기준으로 문자 삽입

End Sub

Sub example_9_2()

Dim varName() As String

Dim i As Long

i = UBound(Split(Cells(3, 1), " ")) - LBound(Split(Cells(3, 1), " ")) + 1

ReDim varName(1 To i)

varName = Split(Cells(3, 1), " ")

Cells(8, 1).Value = Join(varName, "/")

End Sub

이전 포스팅 바로가기

[엑셀 VBA #12] (배열응용) 특정 셀 영역 그대로 복사/이동하기

예제8.xlsm

dim varArray(1 to 20)

dim varArray(-10 to 20)

UBound(varArray) - LBound(varArray) + 1

Sub example_8()

Dim varArray()                    '배열 varArray 선언

Dim capacity As Long            '배열 크기 변수 capacity 설정

Dim Col As Long                    '첫 행의 마지막 값의 열 값 Col 변수 설정

Col = Cells(1, 1).End(2).Column            '첫 행의 마지막 값의 위치를 찾고 열 값을 설정

ReDim varArray(1 To Col)                        '배열 동적선언

varArray = Cells(1, 1).Resize(, Col).Value            '값을 배열에 저장

capacity = UBound(varArray) - LBound(varArray) + 1        '배열의 크기 구하기

MsgBox "배열의 크기는 " & capacity & "입니다."

End Sub

이전 포스팅 바로가기

[엑셀 VBA #11] (배열#1) 배열 이해하기. 배열의 차원과 정적, 동적배열

예제7.xlsm

Option Explicit            '변수가 선언 없이 사용되는걸 방지

Sub example_7()

Dim varArray                'varArray 배열 선언

Const n = 1                '기준으로할 셀의 행값 n 설정

Const m = 1                '기준으로할 셀의 열값 m 설정

Dim i As Integer

Dim p As Integer

i = Cells(n, m).End(2).Column - m + 1        '배열의 가로 크기 구하기

p = Cells(n, m).End(4).Row - n + 1            '배열의 세로 크기 구하기

ReDim varArray(1 To p, 1 To i)                '위에서 구한 배열의 크기로 배열 재선언

varArray = Cells(n, m).Resize(p, i)                '배열의 크기대로 셀(n,m)을 기준으로 배열 저장

Cells(5, 5).Resize(p, i) = varArray                '셀(5,5)에 저장된 배열 불러오기

End Sub

option explicit

Sub example_7_2()

Dim varArray()                    '배열 varArray 선언

Dim n As Long                    '회원 이름이 포함된 셀의 행 n 선언

Dim m As Long                     '회원 이름이 포함된 셀의 열 m 선언

Dim i As Long                        '행의 길이(이동해야 할 셀의 양) 변수 선언

n = Selection.Row                '선택한 셀의 행을 n에 입력

m = Selection.Column                '선택한 셀의 열을 m에 입력

    If m <> 1 Then                    'm의 값이 1이 아닐 경우, 즉 선택한 셀이 이름이 포함된 열이 아닐경우

    MsgBox "회원 이름을 선택해야 합니다."           

    Exit Sub                            '종료

    Else

    End If

i = Sheet9.Cells(n, m).End(2).Column                    '이동해야 할 셀의 양 설정

ReDim varArray(1 To i)                            '이동해야 할 셀의 양에 맞춰서 배열 크기 조절

varArray = Sheet9.Cells(n, m).Resize(, i).Value                    '배열에 복사해야 할 값 지정

Sheet10.Cells(Rows.Count, 1).End(3)(2).Resize(, i) = varArray          '데이터가 들어가야 하는 위치를 찾고 배열을 입력 

Selection.EntireRow.Delete                    '과거로 이동한 인원 자료 현재회원에서 제거

End Sub

Sheet10.Cells(Rows.Count, 1).End(3)(2).Resize(, i) = Sheet9.Cells(n, m).Resize(, i).Value

varArray = Sheet9.Cells(n, m).Resize(, i).Value                

Selection.EntireRow.Delete 

Sheet10.Cells(Rows.Count, 1).End(3)(2).Resize(, i) = varArray