사용자정의함수 (2)
엑셀 VBA #51 / 중복데이터 처리_4 [VBA] - 사용자정의함수
반응형

엑셀 VBA #51 / 중복데이터 처리_4 [VBA] - 사용자정의함수

Sub 중복데이터삭제_단계2()

Dim rng As Range, rngX As Range
Dim i As Long, j As Long
Dim cntR As Long, cntC As Long
Dim strI As String, strJ As String

Set rng = Range("A3", Cells(Rows.Count, "D").End(xlUp))

cntR = rng.Rows.Count
cntC = rng.Columns.Count

For i = 1 To cntR - 1
      strI = fnMerge(rng, i)
      For j = i + 1 To cntR
                   strJ = fnMerge(rng, j)
                   If strI = strJ Then
                                  If rngX Is Nothing Then
                                       Set rngX = rng(j, "A").Resize(1, cntC)
                                  Else
                                       Set rngX = Union(rngX, rng(j, "A").Resize(1, cntC))
                                  End If
                   End If
       Next
Next

If rngX Is Nothing = 0 Then rngX.Delete
End Sub

Function fnMerge(rng As Range, i As Long) As String
Dim col As Long, k As Long
Dim str As String

col = rng.Columns.Count
    For k = 1 To col
        str = str & rng(i, k)                        '?????이해 안됨
    Next
 fnMerge = str
End Function

vba#51.xlsm
0.02MB


https://www.youtube.com/watch?v=EkGRLek1arM&list=PLfxvqpVCYZ8e0qlyc_FU46neoWjO7yTWj&index=51

 


엑셀 VBA #34 / 사용자정의 함수 [VBA]

엑셀 VBA #50 / 중복데이터 처리_3 [VBA]



 

 

반응형
  Comments,     Trackbacks
엑셀 VBA #34 / 사용자정의 함수 [VBA]
반응형

엑셀 VBA #34 / 사용자정의 함수 [VBA]

1. 목적 : VBA코딩시 자주 사용되는 수식을 함수화하여 편이성 도모
2. 구조
    Function 함수명(인수1,인수2,....) As 자료형
       ~~~~~
    End Function
함수명 : 워크시트함수와 동일하면 안됨
자료형 예시 : Integer, Long,....

3. 활용
'엑셀 VBA #32 / 자동필터_1 [VBA]'에서 사용한 'rng.SpecialCells(xlCellTypeVisible).Count'을 사용자정의함수로 만들기
 
4. 코드
Dim sh1 As Worksheet
Dim rng As Range

Set sh1 = Sheets("자동필터")
Set rng = Range("A1").CurrentRegion

If sh1.AutoFilterMode = False Then rng.AutoFilter
If sh1.FilterMode = True Then sh1.ShowAllData

rng.AutoFilter 2, Range("E2")

Range("A20").CurrentRegion.Clear
If Fcnt(rng) = 3 Then                            '사용자정의함수 적용
    MsgBox "해당되는 조건의 데이타가 없음"
    Exit Sub
End If

rng.SpecialCells(xlCellTypeVisible).Copy Range("A20")
End Sub

Function Fcnt(rng As Range) As Long
    Fcnt = rng.SpecialCells(xlCellTypeVisible).Count     
End Function

vba#34.xlsm
0.02MB


https://www.youtube.com/watch?v=sVEJnYuYvQE&list=PLfxvqpVCYZ8e0qlyc_FU46neoWjO7yTWj&index=34

반응형
  Comments,     Trackbacks
최근 작성 글
최근 작성 댓글
최근 작성 트랙백
프로필
공지사항
글 보관함
캘린더
«   2024/12   »
1 2 3 4 5 6 7
8 9 10 11 12 13 14
15 16 17 18 19 20 21
22 23 24 25 26 27 28
29 30 31
TODAY TOTAL