rand(life)

[엑셀VBA] 여러시트에서 같은 항목 합계 -- 사용자정의함수사용 본문

컴퓨터/엑셀

[엑셀VBA] 여러시트에서 같은 항목 합계 -- 사용자정의함수사용

flogsta 2010. 7. 31. 11:32

  지난번에 다루었던 "통합"기능은, 데이터가 한 줄 (예를 들면 A열)에만 나열되어있어야 가능한 방법이었다. 위의 그림처럼 여러 열에 걸쳐 데이터가 입력되어있을 때, 여러시트와 여러 열에 걸쳐 입력되어있는 특정인의 금액을 합산하려면 어떻게 할까? 일반 함수나 기능으로는 안될 것 같고, VBA를 이용해야할 것 같다



일단, 합계를 낼 시트의 이름을 total이라고하고, 맨 왼쪽에 놓는다. A열에 각 사람의 이름이 나열되고, C열에 금액을 입력할 예정이다. 책을 찾아보고 검색해서 연구한 끝에 매크로로 만든 것은 다음과 같다. 


Private Sub Macro1()
Dim n, j As Long

Dim i As Integer
Dim k As Integer
Dim m As Integer
Dim t As Integer
Dim pname As String
 

'합계를 낼 시트는 이름을 total로 하고, 맨 왼쪽에 위치하도록 한다.

'1행은 제목행이고, 2행부터 사람이름이 나오므로, For ~ Next구문을 2부터 시작한다.

'현재셀(Activecell)과 연결되어있는 모든 구역(CurrentRegion)의 행(Rows)의 개수(Count)(즉, 사람이름수)만큼 반복한다.
For t = 2 To ActiveCell.CurrentRegion.Rows.Count
 

'변수 pname에 total시트의 t행, 1열 (처음에는 2행1열이므로, A2셀을 의미함)의 값(처음에는 "성춘향"이다)을 배정한다.
pname = Worksheets("total").Cells(t, 1).Value
 

'다음 사람 차례가 되었을 때 j와 n의 값이 그대로 있으면 안되므로, 0으로 초기화시킨다.
j = 0
n = 0
 

'두번째 시트부터 계산하므로, 2에서 시작한다.

'전체 시트의 개수(Sheets.Count)만큼 반복한다.
For m = 2 To Sheets.Count

'm번째의 시트 (처음에는 두 번째시트)를 선택한다.
Sheets(m).Select

'워크시트함수(일반함수)인 CountIF함수를 사용하기 위해 Application.WorksheetFunction.을 앞에 붙인다.

'두번째 시트에서 데이터가 입력된 영역중에서 pname변수에 할당된 값(처음에는 성춘향)이 몇번 사용되었는지 세어서 k변수에 할당한다.
k = Application.WorksheetFunction.CountIf(Sheets(m).UsedRange, pname)
 
'그 시트에 이름이 하나도 안 나오면 nextloop이라는 이름의 위치로 넘어간다.
If k 0 Then GoTo nextloop
 

'그 시트에 해당 이름이 나오는 회수만큼 반복한다.
For i = 1 To k
 

'pname변수에 할당된 값(처음에는 "성춘향")을 찾아서 활성화시킨다. (선택한다)
Cells.Find(What:=pname, after:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, MatchByte:=False, SearchFormat:=False).Activate
 
'활성화된 셀의 한칸 오른쪽(Offset(0,1) 셀의 값을 변수 j에 할당한다.
j = ActiveCell.Offset(0, 1).Value
'변수 j는 찾기를 할 때마다 수치가 바뀌므로, 찾은 수치들을 계속 합산해둘 변수 n에 차곡차곡 더해준다.
n = n + j

'total시트의 t행 3열 (처음에는 C2셀)에 변수n에 들어있는 값을 넣는다.
Worksheets("total").Cells(t, 3).Value = n
 

'해당 시트에서 해당 이름이 또 있는지 찾기 위해 찾기작업을 또 한다.
Next i
'해당 시트에 해당 이름이 없으면 다음 시트로 넘어간다.
nextloop:
Next m

'해당 이름에 대한 합산이 모두 끝났으면 다음 사람으로 넘어간다.
Next t

'계산이 모두 끝났으면 total시트를 선택하여 보여준다.
Worksheets("total").Select
 
End Sub


테스트를 해 보았더니, 잘 된다.
하지만 시트의 수가 많아지면 현저하게 속도가 떨어진다. 한 사람당 For ~ Next구문을 세 번을 반복하게 되니 아무래도 시스템에 무리가 갈 것이다.
그래서 사용자 정의함수로 만들어보려고 시도했다.
 

'함수명은fnalsum이며, 데이터형 인수를 하나 받아 pname이라는 변수에 저장한다)
Function fnalsum(pname As String)
Dim n As Long, j As Long
Dim m As Integer
Dim rnga As Range
Dim firstloc As String

'합계를 내는 시트가 첫번째 시트에 있다고 가정하고, 두 번째 시트부터 문자열을 찾는다.
For m = 2 To Sheets.Count

'pname변수에 있는 값을 m번째 시트에서 찾아, rnga 변수에 그 셀범위를 할당한다. 이름은 "범위"이지만, 셀 한 개도 범위로 간주하므로, 결국 찾기해서 해당 이름을 발견한 셀의 위치가 rnga에 할당되는 셈이다
Set rnga = Sheets(m).UsedRange.Find(What:=pname, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, MatchByte:=False, SearchFormat:=False)

'변수 rnga 가 비어있지 않다면, 즉, 해당 이름을 찾았다면
If Not rnga Is Nothing Then

'변수 rnga에 들어있는 셀주소(즉, 해당 이름을 찾은 셀주소)를 firstloc이라는 변수에 할당한다.

    firstloc = rnga.Address

'Do Loop ~ Until ... 반복문이다 "…할 때까지 ~를 계속 반복하라"는 의미
  Do

'찾은 셀의 한 칸 오른쪽에 있는 값(즉, 해당 사람이 낸 금액)을 변수 j에 할당한다.

   j = rnga.Offset(0, 1).Value    

'변수 n에 차곡차곡 합산해둔다

    n = n + j

'해당 시트에서 한 번 더 찾는다
' after:=rnga 는 앞서 찾은 rnga의 이후에서 찾는다는 의미이다. After: 부분을 빼면 해당 시트의 최상단 좌측 (A1셀)부터 찾는다.
    Set rnga = Sheets(m).UsedRange.FindNext(after:=rnga)

'firstloc에 저장해둔, 해당 사람의 이름을 이 시트에서 맨 처음으로 발견했던 위치하고, 지금 발견한 위치(rnga.Address)가 일치하면 Do ~Loop Until…. 구문에서 빠져나온다.
 Loop Until firstloc Like rnga.Address         

'앞서 있었던 if구문을 종료한다.
Else
End If

'다음번 시트로 넘어간다.
Next m

'모든 시트가 다 계산이 끝나면, 변수 n에 차곡차곡 합산해 두었던 값을 fnalsum함수 계산의 결과값으로 보여준다
fnalsum = n

End Function


나름대로 잘 만들었다고 생각했는데, 실제로 사용해보니 #VALUE! 오류가 뜬다.
어디가 잘못 되었는지 확인하고 싶은데 Function 프로시저에서는 한단계씩 실행(F8)이 안된다. 할 수 없이 Sub 프로시저 (매크로 )로 바꾸어 보았다.

Sub test()

Dim n As Long, j As Long
Dim m As Integer
Dim rnga As Range
Dim firstloc As String
Dim pname As String

'사용자정의함수가 아니라서 변수 pname에 들어갈 값을 인수로 받을 수 없으므로 여기서 강제로 pname변수의 값을 A2셀에 있는 값으로 지정해 주었다.
pname = Worksheets("total").Cells(2, 1).Value

For m = 2 To Sheets.Count

Set rnga = Sheets(m).UsedRange.Find(What:=pname, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, MatchByte:=False, SearchFormat:=False)
  
      
If Not rnga Is Nothing Then
firstloc = rnga.Address

    Do
   j = rnga.Offset(0, 1).Value
     
    n = n + j

    Set rnga = Sheets(m).UsedRange.FindNext(after:=rnga)
  
    Loop Until firstloc Like rnga.Address
      
      
Else
End If

Next m
'결과값을 C2셀에 출력하도록 해 주었다.
Worksheets("total").Cells(2, 3).Value = n

End Sub



그런데 지금은 훌륭하게 잘 된다! Function 에서 Sub으로 바뀌면서 고친 부분은 주석문으로 표시한 저 두 줄 밖에 없는데, 왜 Sub에서는 되고 Function에서는 안 될까?
아무리 생각해도 모르겠고, 이 의문에 대한 답은 책에도, 인터넷에도 없다. 그래서 네이버 지식인에 질문했다.
하루도 지나지 않아 답변이 두 개가 등록되었다.
내가 채택한 답변은 다음과 같다. (주석문은 내가 붙였다)
 

' 함수 계산에 의해 반환되는 값의 데이타형식을 정해주기 위해 뒤에 As Double을 붙인다.
Function fnalsum(pname As String) As Double
Dim n As Double
Dim m As Integer
Dim rng As Range

' 휘발성, 즉 참조하는 셀의 값이 바뀔때 이전 계산값이 유지되는 것이 아니라 바뀌도록, 즉시 다시 계산되도록 해준다.
Application.Volatile
For m = 2 To Sheets.Count

'specialcells는 F5키를 누르면 볼 수 있는 "이동"으로 선택한 특수한 셀들. 괄호안에 2가 있으면 수식이 아닌 상수(여기서는 사람이름)가 입력된 모든 셀들을 선택하게 된다
For Each rng In Sheets(m).UsedRange.SpecialCells(2)
If rng = pname Then

'range.Next 속성은 탭키를 대신한다. 한 줄 오른쪽에 있는 셀을 가리킨다.

'Val 함수는 텍스트를 숫자로 바꾸어준다. 따라서, "10000원"이라고 입력된 셀도 "10000"으로 인식하게 만들어준다.
n = n + Val(rng.Next) 


End If
Next rng
Next m
fnalsum = n
End Function



살펴보니 네이버지식인 엑셀부문 1위하시는 분답게 코드가 깔끔하다. 이럴때는 고수와의 실력차가 많이 난다는게 확연히 느껴진다. 하던 공부도 그만두고 싶다. ㅜㅜ
그런데, 내가 정말로 원한 것은 더 나은 방법이 아니라, 내가 한 방법이 어디가 잘못되었나이다.
좀 더 연구해보자.