728x90

업체별 공급가액 합계 및 정렬 방법1


업체별 공급가액을 합친 금액을 자동 계산하는 VBA 코드입니다.

원본 데이터는 다른 시트에 있고 현재 시트에서 가져오고자 하는 걸 가져오는 것입니다.




이런 결과를 가져오구요.


아래는 VBA Code 입니다. F8키를 눌러서 버그가 있는지 일일이 점검해서 완벽하게 동작합니다.


Option Explicit
Sub 업체별공급가합계()

    Dim rngC As Range    '// 각 셀을 넣을 변수
    Dim rngAll As Range  '// 색상 전체 데이터 영역을 넣을 변수
    Dim cnt, i, j As Long
    Dim Sum_Cnt As Double   '// 상황에 따라 Long, Double 지정
   
    Application.ScreenUpdating = False        '화면 업데이트 (일시) 정지
   
    Cells(1, "A").CurrentRegion.Offset(1).Clear  '// 기존 데이터 삭제
   
    '-------------------- Sheets("매출장") B열을 복사 ----------------------------------
    For i = 2 To Sheets("매출장").Cells(Rows.Count, "B").End(3).Row
        Cells(i, "A").Value = Sheets("매출장").Cells(i, "B").Value
    Next i
  
    '-------------------  중복값 모두 제거 ----------------------------
    For i = 2 To Cells(Rows.Count, "A").End(3).Row          '// A열 각셀을 순환
        For j = i + 1 To Cells(Rows.Count, "A").End(3).Row
            If Cells(i, "A") = Cells(j, "A") Then
               Cells(j, "A").Delete Shift:=xlUp         '// 셀을 위로 밀면서 삭제
               j = j - 1                                '// 셀이 삭제되었으므로 변수 1을 빼줌
            End If
        Next j
    Next i

    '------------------- 같은 이름별로 공급가액 더하기 --------------------------------
    Sum_Cnt = 0
    Set rngAll = Range([A2], Cells(Rows.Count, "A").End(3))
    For Each rngC In rngAll
        For i = 2 To Sheets("매출장").Cells(Rows.Count, "B").End(3).Row
            If rngC.Value = Sheets("매출장").Cells(i, "B").Value Then
                Sum_Cnt = Sum_Cnt + Sheets("매출장").Cells(i, "E").Value   '//공급가액 열
                rngC.Offset(0, 1).Value = Sum_Cnt
            End If
        Next i
        rngC.Offset(0, 2).Value = rngC.Offset(0, 1).Value * 0.1   '// 부가세 10%
        rngC.Offset(0, 3).Value = rngC.Offset(0, 1).Value + rngC.Offset(0, 2).Value
        Sum_Cnt = 0
    Next rngC
   
    '--------------- 셀 서식지정 및 가운데 정렬, 선그리기 ----------------------------
    Range([B2], Cells(Rows.Count, "D").End(3)).NumberFormat = "#,###" '// 셀서식 : 3단위 콤마
    Range("A1").CurrentRegion.HorizontalAlignment = xlCenter
    ActiveSheet.UsedRange.Borders.LineStyle = 1     '// 현재시트 사용영역 선그리기
   
    '-------------------- 내림차순 정렬 (필요한 경우에만 하면 됨) -------------------------------
    With Range("A2").CurrentRegion
        .Sort key1:=Range("B2"), order1:=xlDescending
    End With
   
    '------------------ 개체변수 초기화(메모리 비우기) -----------------------------
    Set rngAll = Nothing
   
    MsgBox "작업완료"
   
End Sub

첨부파일 첨부하니 필요하신 분은 받아가세요.


매출장.xlsm



728x90
블로그 이미지

Link2Me

,