도움되는 블로그

예제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