VBA 3일차

<3일차>

1. VBA 함수에서 Optional(선택인수)는 마지막 부분에만 위치할 수 있음

2. Range.Offset(행이동,열이동): Range에서 행, 열 개수만큼 이동한 셀을 반환

3. 이벤트매크로

(1) VBA->SheetX->(일반) Worksheet 선택->자동으로 (선언) SelectionChange 선택됨 -> 마스터코드 및 셀주소 입력 -> 아랫줄에 모듈에서 작성한 sub명 입력

(2) SelectionChange 이벤트는 셀을 클릭했을 때 동작

(3) Change 이벤트는 셀이 변경되었을 때 동작 -> 셀이 순차적으로 변경되며 연속적으로 동작할 수 있으므로 이벤트마스터코드 쓸 것!

4. 실습코드

(1)

Function MyTextJoin(Rng As Range, _
Optional Delimiter As String = ",")
'@ 인수 설명
'Rng : 값을 병합할 범위입니다.
'Delimiter : [선택인수] 구분자입니다. 기본값은 쉼표(,)입니다.

Dim r As Range 'For Each문 변수
Dim Result As String '결과로 출력할 문자열

'힌트1) For Each r In Rng
'힌트2) If r.Value <> "" Then
'힌트3) Result = Result & r.Value & Delimiter
For Each r In Rng
If r.Value <> "" Then
Result = Result & r.Value & ", "
End If
Next

'힌트4) MyTextJoin = Left(○○○, Len(○○○) - 1)
MyTextJoin = Left(Result, Len(Result) - 2)

End Function

(2)

Sub ClearRange()

Dim i As Long

i = Sheet1.Range("G" & "1048576").End(xlUp).Row

If i > 1 Then
Sheet1.Range("G2:H" & i).ClearContents
End If

End Sub

(3)

Function DynamicRange(WS As Worksheet, Column As String, Initrow As Long) As Range

Dim i As Long
Dim Address As String

i = WS.Range(Column & "1048576").End(xlUp).Row
Address = Column & Initrow & ":" & Column & i

Set DynamicRange = WS.Range(Address)

End Function

(4)

Sub test()

MsgBox DynamicRange(Sheet1, "C", 2).Address

End Sub

(5)

Sub FilterItems()

'GroupRng(구분)의 조건을 비교해서, 구분에 해당하는 제품과 가격을 표시

Dim GroupRng As Range ' 필터링 할 구분 범위 (동적으로 설정!)
Dim r As Range ' GroupRng를 For Each로 하나씩 참조할 셀
Dim FilterVal As String ' 비교할 조건
Dim i As Long ' r의 값이 조건과 같을 경우, 1씩 증가할 정수

Set GroupRng = DynamicRange(Sheet1, "A", 2)
FilterVal = Range("E2")

i = 2
For Each r In GroupRng
If r.Value = FilterVal Then
Sheet1.Range("G" & i).Value = r.Offset(0, 1).Value
Sheet1.Range("H" & i).Value = r.Offset(0, 2).Value
i = i + 1
End If
Next

End Sub

(6)

Private Sub Worksheet_Change(ByVal Target As Range)

Application.ScreenUpdating = False
Application.EnableEvents = False

If Not Intersect(Target, Range("E2")) Is Nothing Then
ClearRange
FilterItems
End If

Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub