A에는 있지만 B에는 없는 것
A에는 없지만 B에는 있는 것
A와 B동시에 있는 것
세가지 조건을 충족하기 위해 애 좀 먹었다.
Option Explicit Private rngWs1 As Range Private rngWs2 As Range Private wS1 As Worksheet Private wS2 As Worksheet Private wbOld As Workbook Private varClt As Variant Sub mkFile() Dim cltWs1 As New Collection Dim cltWs2 As New Collection Dim rng As Range Application.ScreenUpdating = False '각 시트 및 현재 워크북 변수 설정 Set wS1 = Sheets(1) Set wS2 = Sheets(2) Set wbOld = ThisWorkbook '거래처 영역 변수 설정 With wS1 Set rngWs1 = .Range("A2", .Cells(Rows.Count, "A").End(xlUp)) End With With wS2 Set rngWs2 = .Range("A2", .Cells(Rows.Count, "A").End(xlUp)) End With '각 시트의 거래처명을 중복값 제외하고 받아오기 On Error Resume Next For Each rng In rngWs1 cltWs1.Add rng, CStr(rng) Next rng For Each rng In rngWs2 cltWs2.Add rng, CStr(rng) Next rng On Error GoTo 0 fnMakeFile cltWs1, 0 'A시트에만 데이터가 있을 때 fnMakeFile cltWs1, 1 'A,B시트에 데이터가 동시에 있을 때 fnMakeFile cltWs2, 0 'B시트에만 데이터가 있을 때 'A시트 필터링 제거 wS1.ShowAllData wS2.ShowAllData Application.ScreenUpdating = True End Sub Sub fnMakeFile(cltCollection As Collection, intCount As Integer) Dim wbNew As Workbook Dim wsPaste As Worksheet Dim rngFor As Range Dim i As Integer Application.ScreenUpdating = False Select Case cltCollection.Item(1).Parent.Index Case 1 Set rngFor = rngWs2 Set wsPaste = wS1 Case 2 Set rngFor = rngWs1 Set wsPaste = wS2 End Select For Each varClt In cltCollection Select Case intCount Case 0 If WorksheetFunction.CountIf(rngFor, varClt) = 0 Then Workbooks.Add Set wbNew = ActiveWorkbook wbOld.Activate With wsPaste.Range("A1") .AutoFilter field:=1, Criteria1:=varClt .CurrentRegion.Copy wbNew.Sheets(1).Range("A1") End With End If Case 1 If WorksheetFunction.CountIf(rngFor, varClt) Then For i = 1 To 2 If i = 1 Then Workbooks.Add Set wbNew = ActiveWorkbook wbOld.Activate End If With Sheets(i).Range("A1") .AutoFilter field:=1, Criteria1:=varClt .CurrentRegion.Copy wbNew.Sheets(i).Range("A1") End With Next i End If End Select If Not wbNew Is Nothing Then wbNew.Close savechanges:=True, Filename:=wbOld.Path & "\" & varClt & ".xlsx" Set wbNew = Nothing End If Next varClt Application.ScreenUpdating = True End Sub | cs |
'VB(A)' 카테고리의 다른 글
하위 폴더의 파일명, 수정날짜, 경로 가져오기 (0) | 2015.07.31 |
---|---|
배열의 합, 최대치 구하기 (0) | 2015.07.28 |
대량의 데이터 변환 (0) | 2015.07.27 |
대괄호 이동 (0) | 2015.07.27 |
합계가 될 때까지 숫자를 랜덤하게 뿌리기 (0) | 2015.07.27 |