학습노트
VBA 4일차
A <4일차>
1. Collection cf) Array
(1) 새로운 Collection 만들기
Dim Coll As Colletion
Set Coll = New Collection
(2) Collection에 값 추가하기
Coll.Add 값
Coll.Add 값, Key
(3) Collection의 값 제거하기
Coll.Remove(Key)
(4) Collection 값 돌아가며 확인하기
Dim v As Variant
For Each v In Coll
Debug. Print v
Next
2. On Error Resume Next: 오류 무시하고 다음 단계로 진행
3. On Error Goto 0: 오류발생시 중단하고 오류메시지 표시
4. F4: 속성창 실행
5. With문: 같은 변수를 여러번 작성할 때 사용
Dim WS As WorkSheet
Set WS = Sheet1
WS.Range("A1").Font.Size = 14
WS.Range("A1").Interior.Color = vbRed
Ws.Range("A1").RowHeight = 15
>> 아래와 같이 작성
With WS.Range("A1")
.Font.Size = 14
.Interior.Color = vbRed
.RowHeight = 15
End With
6. 실습코드
(1)
Function MyCountIf(Rng As Range, Criteria As Variant) As Long
Dim R As Range
Dim i As Long
For Each R In Rng
If R.Value = Criteria Then
i = i + 1
End If
Next
MyCountIf = i
End Function
(2)
Function MySumIf(Rng As Range, Criteria As Variant, Sum_Range As Range) As Long
Dim i As Long
Dim Result As Long
For i = 1 To Rng.Count
If Rng(i) = Criteria Then
Result = Result + Sum_Range(i)
End If
Next
MySumIf = Result
End Function
(3)
Sub test()
Dim Coll As Collection
Set Coll = New Collection
Coll.Add "사과", "Fruit1"
Coll.Add "배", "Fruit2"
Coll.Add "포도", "Fruit3"
Coll.Remove ("Fruit3")
Dim v As Variant
For Each v In Coll
MsgBox v
Debug.Print v
Next
End Sub
(4)
Function UniqueTextJoin(Rng As Range, Optional delimiter As String = ", ")
'Dim Rng As Range
'Dim delimiter As String
Dim R As Range
Dim Coll As Collection
Dim v As Variant
Dim Result As String
'Set Rng = DynamicRange(Worksheets("품목검색"), "A", 2)
'delimiter = ", "
Set Coll = New Collection
On Error Resume Next
For Each R In Rng
Coll.Add R.Value, R.Value
Next
On Error GoTo 0
For Each v In Coll
Result = Result & v & delimiter
Next
Result = Left(Result, Len(Result) - Len(delimiter))
'MsgBox Result
UniqueTextJoin = Result
End Function
(5)
Sub AddValidation()
Dim Rng As Range
Dim UniqueRng As Range
Set Rng = Sheet1.Range("E2")
Set UniqueRng = DynamicRange(Sheet1, "A", 2)
Rng.Validation.Delete
Rng.Validation.Add xlValidateList, , , UniqueTextJoin(UniqueRng)
End Sub
(6) 개별sheet
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
Application.EnableEvents = False
If Not Intersect(Target, Range("E2")) Is Nothing Then
AddValidation
End If
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
(7) 사용자폼에서 이름 바꾼 후 버튼등록
Private Sub btnSubmit_Click()
Dim i As Long
i = Sheet1.Range("A1048576").End(xlUp).Row + 1
Sheet1.Range("A" & i).Value = Me.txtCategory.Value
Sheet1.Range("B" & i).Value = Me.txtProduct.Value
Sheet1.Range("C" & i).Value = Me.txtPrice.Value
MsgBox "제품을 등록하였습니다!"
Me.txtCategory.Value = ""
Me.txtProduct.Value = ""
Me.txtPrice.Value = ""
End Sub
(8)
Sub ShowForm()
frmAddProduct.Show
End Sub
최
Y
김
인
댓글 0