시트가 아래와 같을 때 피벗테이블 기능을 사용하지 않고 vba만으로 상대계좌별로 출금 입금 집계하기
gpt가 만든 코드로 뼈대를 잡고 실제 작동하도록 수정함.
결과
1 . 시트에서 바로 작업
Function SumIfs2D(dataArray As Variant, criteria1pos As Integer, criteria1 As Variant, criteria2pos As Integer, criteria2 As Variant, SumPos As Integer) As Double
Dim sumResult As Double
Dim i As Long
' 합계 초기화
sumResult = 0
' 배열 순회하며 조건에 맞는 값을 합산
For i = 1 To UBound(dataArray, 1)
If dataArray(i, criteria1pos) = criteria1 And dataArray(i, criteria2pos) = criteria2 Then
sumResult = sumResult + dataArray(i, SumPos)
End If
Next i
' 결과 반환
SumIfs2D = sumResult
End Function
Sub 추출하기2()
Dim 원본시트 As Worksheet
Dim 결과시트 As Worksheet
Dim 원본범위 As Range
Dim 결과범위 As Range
Dim 결과행 As Long
Dim 계좌목록 As Object
Dim 데이터 As Variant
Dim 결과 As Variant
Dim i As Long
' 기존 결과 시트 삭제
On Error Resume Next
Application.DisplayAlerts = False
ThisWorkbook.Sheets("결과").Delete
Application.DisplayAlerts = True
On Error GoTo 0
' 원본 시트와 결과 시트 설정
Set 원본시트 = ThisWorkbook.Sheets("Sheet1")
Set 결과시트 = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
결과시트.Name = "결과"
' 원본 데이터 범위 로드
Set 원본범위 = 원본시트.Range("A2:E" & 원본시트.Cells(Rows.Count, 1).End(xlUp).Row)
데이터 = 원본범위.Value
' 결과 시트에 헤더 설정
결과시트.Range("A1:E1").Value = Array("계좌번호", "상대계좌번호", "지급금액합계", "입금금액합계", "거래건수")
' 계좌별로 합계 계산
Set 계좌목록 = CreateObject("Scripting.Dictionary")
결과행 = 2
ReDim 결과(1 To 1000, 1 To 5)
For i = 1 To UBound(데이터, 1)
Dim 계좌번호 As String
Dim 상대계좌번호 As String
Dim 지급금액 As Double
Dim 입금금액 As Double
계좌번호 = 데이터(i, 1)
상대계좌번호 = 데이터(i, 5)
지급금액 = IIf(데이터(i, 3) = "-" Or 데이터(i, 3) = "", 0, 데이터(i, 3))
입금금액 = IIf(데이터(i, 4) = "-" Or 데이터(i, 4) = "", 0, 데이터(i, 4))
If Not 계좌목록.Exists(계좌번호 & 상대계좌번호) Then
계좌목록.Add 계좌번호 & 상대계좌번호, 1
결과(결과행, 1) = 계좌번호
결과(결과행, 2) = 상대계좌번호
'결과(결과행, 3) = WorksheetFunction.SumIfs(원본범위.Columns(3), 원본범위.Columns(1), 계좌번호, 원본범위.Columns(5), 상대계좌번호)
결과(결과행, 3) = SumIfs2D(데이터, 1, 계좌번호, 5, 상대계좌번호, 3)
'결과(결과행, 4) = WorksheetFunction.SumIfs(원본범위.Columns(4), 원본범위.Columns(1), 계좌번호, 원본범위.Columns(5), 상대계좌번호)
결과(결과행, 4) = SumIfs2D(데이터, 1, 계좌번호, 5, 상대계좌번호, 4)
결과행 = 결과행 + 1
' Else
' 계좌목록(계좌번호 & 상대계좌번호) = 계좌목록(계좌번호 & 상대계좌번호) + 1
End If
'
' 데이터(i, 3) = 지급금액
' 데이터(i, 4) = 입금금액
Next i
' 결과 데이터 준비
' ReDim 결과(1 To 계좌목록.Count, 1 To 5)
'
' For i = 1 To 계좌목록.Count
' 결과(i, 1) = Split(계좌목록.Keys()(i - 1), "|")(0)
' 결과(i, 2) = Split(계좌목록.Keys()(i - 1), "|")(1)
' 결과(i, 3) = WorksheetFunction.SumIfs(원본범위.Columns(3), 원본범위.Columns(1), 결과(i, 1), 원본범위.Columns(5), 결과(i, 2))
' 결과(i, 4) = WorksheetFunction.SumIfs(원본범위.Columns(4), 원본범위.Columns(1), 결과(i, 1), 원본범위.Columns(5), 결과(i, 2))
' 결과(i, 5) = 계좌목록(계좌목록.Keys()(i - 1))
' Next i
' 결과 시트에 결과 데이터 붙여넣기
결과시트.Range("A2").Resize(UBound(결과, 1), UBound(결과, 2)).Value = 결과
' 결과 시트 서식 설정
결과시트.Columns("C:D").NumberFormat = "0"
' 결과 시트에 테이블 형식으로 변환
Set 결과범위 = 결과시트.Range("A1:E" & 결과시트.Cells(Rows.Count, 1).End(xlUp).Row)
결과시트.ListObjects.Add(xlSrcRange, 결과범위, , xlYes).Name = "결과테이블"
결과시트.ListObjects("결과테이블").TableStyle = "TableStyleLight1"
' 결과 시트에 필터 적용
결과시트.Range("A1:E1").AutoFilter
' 결과 시트에 데이터 테이블 제목 설정
결과시트.Cells(1, 1).Value = "계좌별 거래 요약"
결과시트.Cells(1, 1).Font.Size = 14
결과시트.Cells(1, 1).Font.Bold = True
' 결과 시트에 데이터 테이블 범위 설정
결과시트.Range("A1:E" & 결과시트.Cells(Rows.Count, 1).End(xlUp).Row).Columns.AutoFit
' 메시지 박스로 작업 완료 알림
MsgBox "작업이 완료되었습니다.", vbInformation
End Sub
2. 속도 향상을 위해 범위를 변수에 할당 후 메모리에서 작업하도록 개선
* sumifs함수를 사용하면 아무래도 속도 저하게 발생하여 sumifs2d로 배열에서 바로 집계하는 함수를 만들어서 적용함
Function SumIfs2D(dataArray As Variant, criteria1pos As Integer, criteria1 As Variant, criteria2pos As Integer, criteria2 As Variant, SumPos As Integer) As Double
Dim sumResult As Double
Dim i As Long
' 합계 초기화
sumResult = 0
' 배열 순회하며 조건에 맞는 값을 합산
For i = 1 To UBound(dataArray, 1)
If dataArray(i, criteria1pos) = criteria1 And dataArray(i, criteria2pos) = criteria2 Then
sumResult = sumResult + dataArray(i, SumPos)
End If
Next i
' 결과 반환
SumIfs2D = sumResult
End Function
Sub 추출하기2()
Dim 원본시트 As Worksheet
Dim 결과시트 As Worksheet
Dim 원본범위 As Range
Dim 결과범위 As Range
Dim 결과행 As Long
Dim 계좌목록 As Object
Dim 데이터 As Variant
Dim 결과 As Variant
Dim i As Long
' 기존 결과 시트 삭제
On Error Resume Next
Application.DisplayAlerts = False
ThisWorkbook.Sheets("결과").Delete
Application.DisplayAlerts = True
On Error GoTo 0
' 원본 시트와 결과 시트 설정
Set 원본시트 = ThisWorkbook.Sheets("Sheet1")
Set 결과시트 = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
결과시트.Name = "결과"
' 원본 데이터 범위 로드
Set 원본범위 = 원본시트.Range("A2:E" & 원본시트.Cells(Rows.Count, 1).End(xlUp).Row)
데이터 = 원본범위.Value
' 결과 시트에 헤더 설정
결과시트.Range("A1:E1").Value = Array("계좌번호", "상대계좌번호", "지급금액합계", "입금금액합계", "거래건수")
' 계좌별로 합계 계산
Set 계좌목록 = CreateObject("Scripting.Dictionary")
결과행 = 2
ReDim 결과(1 To 1000, 1 To 5)
For i = 1 To UBound(데이터, 1)
Dim 계좌번호 As String
Dim 상대계좌번호 As String
Dim 지급금액 As Double
Dim 입금금액 As Double
계좌번호 = 데이터(i, 1)
상대계좌번호 = 데이터(i, 5)
지급금액 = IIf(데이터(i, 3) = "-" Or 데이터(i, 3) = "", 0, 데이터(i, 3))
입금금액 = IIf(데이터(i, 4) = "-" Or 데이터(i, 4) = "", 0, 데이터(i, 4))
If Not 계좌목록.Exists(계좌번호 & 상대계좌번호) Then
계좌목록.Add 계좌번호 & 상대계좌번호, 1
결과(결과행, 1) = 계좌번호
결과(결과행, 2) = 상대계좌번호
'결과(결과행, 3) = WorksheetFunction.SumIfs(원본범위.Columns(3), 원본범위.Columns(1), 계좌번호, 원본범위.Columns(5), 상대계좌번호)
결과(결과행, 3) = SumIfs2D(데이터, 1, 계좌번호, 5, 상대계좌번호, 3)
'결과(결과행, 4) = WorksheetFunction.SumIfs(원본범위.Columns(4), 원본범위.Columns(1), 계좌번호, 원본범위.Columns(5), 상대계좌번호)
결과(결과행, 4) = SumIfs2D(데이터, 1, 계좌번호, 5, 상대계좌번호, 4)
결과행 = 결과행 + 1
' Else
' 계좌목록(계좌번호 & 상대계좌번호) = 계좌목록(계좌번호 & 상대계좌번호) + 1
End If
'
' 데이터(i, 3) = 지급금액
' 데이터(i, 4) = 입금금액
Next i
' 결과 데이터 준비
' ReDim 결과(1 To 계좌목록.Count, 1 To 5)
'
' For i = 1 To 계좌목록.Count
' 결과(i, 1) = Split(계좌목록.Keys()(i - 1), "|")(0)
' 결과(i, 2) = Split(계좌목록.Keys()(i - 1), "|")(1)
' 결과(i, 3) = WorksheetFunction.SumIfs(원본범위.Columns(3), 원본범위.Columns(1), 결과(i, 1), 원본범위.Columns(5), 결과(i, 2))
' 결과(i, 4) = WorksheetFunction.SumIfs(원본범위.Columns(4), 원본범위.Columns(1), 결과(i, 1), 원본범위.Columns(5), 결과(i, 2))
' 결과(i, 5) = 계좌목록(계좌목록.Keys()(i - 1))
' Next i
' 결과 시트에 결과 데이터 붙여넣기
결과시트.Range("A2").Resize(UBound(결과, 1), UBound(결과, 2)).Value = 결과
' 결과 시트 서식 설정
결과시트.Columns("C:D").NumberFormat = "0"
' 결과 시트에 테이블 형식으로 변환
Set 결과범위 = 결과시트.Range("A1:E" & 결과시트.Cells(Rows.Count, 1).End(xlUp).Row)
결과시트.ListObjects.Add(xlSrcRange, 결과범위, , xlYes).Name = "결과테이블"
결과시트.ListObjects("결과테이블").TableStyle = "TableStyleLight1"
' 결과 시트에 필터 적용
결과시트.Range("A1:E1").AutoFilter
' 결과 시트에 데이터 테이블 제목 설정
결과시트.Cells(1, 1).Value = "계좌별 거래 요약"
결과시트.Cells(1, 1).Font.Size = 14
결과시트.Cells(1, 1).Font.Bold = True
' 결과 시트에 데이터 테이블 범위 설정
결과시트.Range("A1:E" & 결과시트.Cells(Rows.Count, 1).End(xlUp).Row).Columns.AutoFit
' 메시지 박스로 작업 완료 알림
MsgBox "작업이 완료되었습니다.", vbInformation
End Sub
'엑셀 > vba' 카테고리의 다른 글
괄호안 숫자만 추출하기 (0) | 2024.01.16 |
---|---|
하위 폴더 포함하여 파일 이름 랜덤 변경 (0) | 2023.11.09 |
열린 모든 통합문서 이름 리스트 박스에 추가하기 (0) | 2023.06.14 |
통합문서의 각 시트 값 복사하기 (0) | 2023.06.13 |
셀 값이 배열에 있는지 비교 chatgpt (0) | 2023.04.10 |