업체별 공급가액 합계 및 정렬 방법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
첨부파일 첨부하니 필요하신 분은 받아가세요.
'업무 능력 향상 > 엑셀 VBA 활용' 카테고리의 다른 글
[VBA] 찾는 글자색에 색상을 주는 FIND VBA (7) | 2014.01.29 |
---|---|
빈행 숨기기 (0) | 2014.01.29 |
색상 개수와 색깔 표시하기 (동일 시트) (0) | 2014.01.26 |
[VBA] 이름별로 구매금액 합계 구하기 (동일 시트) (9) | 2014.01.25 |
[VBA] 현재 시트 Text File로 내보내기 (0) | 2014.01.23 |