엑셀/vba

상대계좌별로 출금 입금 집계하기 with chatgpt

do121 2023. 7. 5. 07:07

시트가 아래와 같을 때 피벗테이블 기능을 사용하지 않고 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