[VBA] 열려있는 엑셀 편집하기

예전에 포스팅한 ERP에서 열린 엑셀을 편집하는 작업의 다른 버전(?)이다.

https://1stminokingdom.tistory.com/152

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

 

이번에 작업할 내용은 예전 글과 비슷하게 열려진 엑셀을 순환하면서 파일이름을 비교하여서 원하는 파일이름이 있으면 그중 필요한 열만 슬라이싱하여 배열에 담은 후 파일 이름을 정규식으로 정리하여 원하는 결과물을 만드는 작업이다.

 

Sub 입고리스트()

    Dim Win As Window
    Dim Wb As Workbook: Set Wb = ThisWorkbook
    Dim wks As Worksheet
    Dim ListWb As Workbook
   
       
    For Each Win In Windows                                     '= 화면순환
        If Win.Visible = True Then                              '= 화면이 최소화가 아니면
           Win.Activate                                         '= 활성화 시켜라
           
           With ActiveWorkbook                                  '= 현재 활성화 된 엑셀파일
           
                Set ListWb = ActiveWorkbook
                
                If InStr(ListWb.Name, "주문내역") > 0 Then      '= 활성화 된 파일명에 [주문내역] 키워드가 있으면...
                
                    Dim Vtemp, Vall, RowV, Vresult
                    Dim rngAll As Range
                    Dim rngA As Range
                    
                        Vtemp = ListWb.ActiveSheet.UsedRange
                        
                                                                '= 헤더를 제외한 2행부터 파일의 마지막 끝까지의 행번호
                        RowV = Application.Evaluate("ROW(2:" & UBound(Vtemp, 1) & ")")
                        
                                                                '= 배열 슬라이싱 [ 3, 5, 14, 10 ] 의 열만 가져옴
                        Vall = Application.Index(Vtemp, RowV, Array(3, 5, 14, 10))
                        
                        With Wb.Sheets("입고")
                        
                            .[a2:e10000].ClearContents          '= 영역 초기화
                        
                            .Cells.NumberFormat = "@"           '= 현재 시트의 모든 셀을 문자형으로 변경
                            
                            .[a2].Resize(UBound(Vall, 1), 4) = Vall  '= Vall 배열을 셀에 출력
                            
                            .Columns("d:e").NumberFormat = "#,##0"   '= d열과 e열의 숫자형식 설정
                            
                            
                            Set rngAll = Range(.[a2], .[a2].End(4))
                            
                                                      
                            For Each rngA In rngAll             '= 파일명 정리와 판매가 설정
                            
                                rngA = HajaRex(rngA & "/" & rngA.Next)
                                rngA(1, 5) = Application.RoundUp(rngA(1, 4) / (1 - .[h1]), -2)
                                
                            Next rngA
                            
                            Vresult = Range(.[a2], .[a2].End(4))
                                        
                    End With
                    
                    ListWb.Close False
                
                End If
                
                                 
           End With
           
        End If
    Next Win
    
    Sheets("인쇄").Activate
    
    Application.EnableEvents = False
    
        [b7:b10000].ClearContents
        
        [b7].Resize(UBound(Vresult, 1), 1) = Vresult
        
        Call 초기화
    
    Application.EnableEvents = True
    
    Set rngAll = Range([b7], [b7].End(4))
    
        For Each rngA In rngAll
        
            rngA.Next = Application.XLookup(rngA, Sheets("data").[b2:b50000], Sheets("data").[a2:a50000], , 0)
        
        Next rngA
    
       
End Sub

Function HajaRex(str$)

    Dim Reg As Object: Set Reg = CreateObject("Vbscript.regexp")
    Dim Mat As Object
    Dim temp$
    
    With Reg
        
        .Pattern = "\(\d+\)$"
        .Global = True

    End With
    
    temp = Reg.Replace(str, "")
    
    HajaRex = temp

End Function

 

파일명을 조합을 하게 되면 파일명 + 규격의 형태로 조합이 되는데 

AAA/10m(10개 단위)

ABA/10m X 20 (3456776)

CDA/30mm

 

 

여러가지 형태중 ABA/10m X 20 (3456776) 의 괄호를 포함한 숫자는 상품코드로 의미없는 숫자이기 때문에 파일명을 조합해서 HajaRex() 함수로 파라미터로 넘겨서 정규식으로 파일명중 마지막에 괄호와 숫자를 된 것을 Replace로 정리하는 코드이다.

 

파일을 첨부하면 좋겠지만 개인작업 코드여서 코드만 공개토록 하니 이해하길 바란다.

 

  

그럼 오늘도 멋있는 코드 작성하시길...