VB(A)

자동필터 - 거래명세표 작성

당근쨈 2015. 3. 21. 04:31

시트1에는 데이터가 있고 시트2에는 거래명세서 서식이 있다.

거래명세서에서 거래처셀에 거래처를 입력하면 시트1의 거래처와 일치하는 데이터를 불러온다.

 

1. 병합셀을 풀어 작업이 용이하도록 한다.

2. 거래처 값을 기준으로 자동필터를 실행하여 해당값을 불러온다.

3. 거래처 데이터를 불러온 후 다시 셀을 병합한다.

4. 거래처와 일치하는 값이 없을 땐 on error on resume 과 err.number 구문을 이용하여 에러처리를 하였다.

5. 코드 작성 후 Private Sub Worksheet_Change(ByVal Target As Range) 를 이용하여 코드를 연결해주었다.

 

Sub Macro()
    Dim 표 As Range
    Dim 시트1 As Worksheet, 시트2 As Worksheet
    Dim 거래처 As Range, 명세표 As Range
    Dim 복사값 As Range
    Dim i As Integer, j As Integer
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    
    '영역설정
    Set 시트1 = Sheets(1)
    Set 시트2 = Sheets(2)
    Set 표 = 시트1.Range("A2").CurrentRegion
    Set 거래처 = 시트2.Range("B7")
    Set 명세표 = 시트2.Range("D13")
    
    '기존값 삭제
    명세표.CurrentRegion.Offset(2).ClearContents
    
    '거래처에 값을 입력하면 자동필터 수행하여 값 가져오기
    If LenB(거래처) Then
        표.AutoFilter Field:=1, Criteria1:=거래처
    
        On Error Resume Next
            Set 표 = 표.Offset(1).Resize(표.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
            If Err.Number <> 0 Then GoTo j
        On Error GoTo 0
        
        Set 복사값 = 표.Columns("C:F")
        i = 표.Rows.Count
        
        '병합된 셀 병합 풀고 값 붙여넣기
        명세표.Resize(i, 4).UnMerge
        복사값.Copy
        명세표.PasteSpecial xlPasteValues
        
        '값 붙여넣은 후 셀병합
        j = 13
        With 시트2
            Do While .Cells(j, "D"<> ""
                .Cells(j, "A").Resize(, 4).Merge
                .Cells(j, "G").Resize(, 2).Merge
                j = j + 1
            Loop
        End With
j:
        거래처.Select
        
        '필터설정 된 표 제자리로
        Set 표 = 시트1.Range("A2").CurrentRegion
        표.AutoFilter
        
    End If
    
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    
End Sub
 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Range("B7"), Target) Is Nothing Then Exit Sub
    If Target.Count > 1 Then Exit Sub
    
    If Not Intersect(Range("B7"), Target) Is Nothing Then
        Macro
    End If
End Sub
cs

 

거래명세표.xlsm