[VBA] Old시트 New시트 업데이트하기

아오...브라질한테 축구 질 준 알았지만 너무 발려서....글쓰기도 시르다...

 

의뢰 들어온건데...이걸 공개할 수 있도록 데이터 수정하는게 더 어려워서...그냥

이렇게만 적으려고 한다.

 

1. ERP에서 다운로드 하면 데이터파일과 통합파일이 서로 열린 상태에서 Vlookup 함수를 통해 데이터를 끌어 온것을  VBA로 수정

2. 기존데이터는 업데이트하기

3. 신규데이트 통합시트에 추가하기

4. 등급이 수정가능하여야 하며 등급에 맞게 실시간으로 값이 변경되어야 함

5. 중첩배열 및 배열 속 데이터 활용하여 사용하기

6. 오른쪽 마우스 이벤트로 정렬하기

Option Explicit
Sub 매출리스트()

    Dim Win As Window
    Dim Wb As Workbook: Set Wb = ThisWorkbook
    Dim wks As Worksheet
    Dim ListWb As Workbook
   
    For Each wks In Wb.Sheets
    
        Application.DisplayAlerts = False
            If wks.Name <> "통합" Then wks.Delete
        Application.DisplayAlerts = True
        
    Next wks
   
    For Each Win In Windows                                     '= 화면순환
        If Win.Visible = True Then                              '= 화면이 최소화가 아니면
           Win.Activate                                         '= 활성화 시켜라
           
           With ActiveWorkbook
                Set ListWb = ActiveWorkbook                     '= 처음 연봉리스트의 워크북을 저장
                If .Sheets(1).Name = "연봉" Then
                    
                    .Sheets(1).Copy after:=Wb.Sheets("통합")
                    ActiveSheet.Name = "업로드"
                    
                    Application.DisplayAlerts = False
                        ListWb.Close (0)                        '= 처음 연봉리스트 삭제
                    Application.DisplayAlerts = True
                    
                    Exit For
                       
                End If
                   
           End With
           
        End If
    Next Win
    
    Sheets("통합").Activate
       
End Sub
Sub 통합()

    Dim rngAll As Range
    Dim rngA As Range, rngB As Range
    Dim Vall, Vtemp, V
    Dim N&
    
    Application.EnableEvents = False
    
    With Sheets("통합")
        Set Vall = Range(.[a4], .[a4].End(4))
        
            .[c4:c10000].ClearContents
    End With
    
    With Sheets("업로드")
        Set rngAll = Range(.[a4], .[a4].End(4))
    End With
    
     For Each rngA In rngAll
        If IsError(Application.Match(rngA, Vall, 0)) Then
            
             Vtemp = rngA.Resize(1, 2)
        
             Vtemp(1, 2) = rngA(1, 3).Resize(1, 6)                      '= 중첩배열
             
             Set rngB = Sheets("통합").Cells(Rows.Count, "a").End(3)(2)
             
             rngB(1, 1) = Vtemp(1, 1)
             rngB(1, 4).Resize(1, 6) = Vtemp(1, 2)
             
             Sheets("통합").[a4:i4].Copy
             rngB.Resize(1, 9).PasteSpecial xlPasteFormats              '= 서식복사
        
          Else
        
            N = Application.Match(rngA, Vall, 0) + 3                    '= 기존 멤버들 업데이트
            V = rngA(1, 3).Resize(1, 6)
            Cells(N, 4).Resize(1, 6) = V
    
         End If
                        
    Next rngA
    
    'Haja.Show 0
    Application.EnableEvents = True
    
End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    Dim rngAll As Range
    
    Set rngAll = Sheets("통합").[a3].CurrentRegion.Offset(1)
    Set rngAll = rngAll.Resize(rngAll.Rows.Count - 1, 9)
    
    If Intersect(rngAll, Target) Is Nothing Then Exit Sub
    
    rngAll.Sort key1:=[a3], key2:=[b3], order1:=xlAscending, Header:=xlYes  '= 오른쪽 마우스 클릭시 정렬
    
    Cancel = True
    
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngX As Range
    Dim rngAll As Range
    Dim rngA As Range
    Dim rngD As Range
   
    
    Set rngAll = Range([a4], [a4].End(4))
    Set rngD = rngAll.Offset(, 1)
    
    If Intersect(rngD, Target) Is Nothing Then Exit Sub
    
        On Error Resume Next
        Set rngX = Target.Offset(, -1)
        
        
        Application.EnableEvents = False
            rngX(1, 2) = UCase(rngX(1, 2))                                '= 소문자를 대문자로
        Application.EnableEvents = True
        
        rngX(1, 3) = Haja_Grade(rngX(1, 2).Value)
        rngX(1, 6) = Application.Sum(rngX(1, 3), rngX(1, 4) + rngX(1, 5))
        rngX(1, 7) = WorksheetFunction.RoundDown(rngX(1, 6) * 0.05, -1)   '= 10원단위 절사
        rngX(1, 8) = WorksheetFunction.RoundDown((rngX(1, 6) - rngX(1, 7)) * 0.033, -1)
        rngX(1, 9) = rngX(1, 6) - rngX(1, 7) - rngX(1, 8)
        On Error GoTo 0

End Sub

Function Haja_Grade(grade$)

    Select Case grade
        Case Is = "A"
            Haja_Grade = 60000
        Case Is = "B"
            Haja_Grade = 50000
        Case Is = "C"
            Haja_Grade = 40000
        Case Is = "D"
            Haja_Grade = 30000
        Case Is = "E"
            Haja_Grade = 20000
        Case Is = "F"
            Haja_Grade = 10000
    End Select

End Function

Old시트New시트통합하기.xlsm

2.59MB