VBA, 엑셀 느림 현상 원인 문의

VBA
작성자
김영실
작성일
2021-07-06 12:21
조회
105
엑셀버전 : 엑셀2019

운영체제 : 윈도우10

VBA는 맨날 강의만 듣다가, 처음으로 업무에 적용해보려고 인터넷 검색하면서 대략 만들어봤는데

엑셀이 엄청 느려져서 사실상 의미가 없는 수준으로 만들어졌어요.

ERP에 자료를 복사한 후 팀 관리 양식(사업비)으로 변경하는 용도입니다.

사업비 사용 방식(6개: 구매요구서, 국내출장, 자가차량, 기타비용, 사업비카드, 세금계산서)에 따라서 통합시트(집행내역)에 필요한 정보만 저장되는 방식입니다.

별로 DB(10~300개)도 많지 않고, 개발코드 짠 것도 없는데.. 왜 느려지는 현상이 발생하는지 너무 궁금합니다.

그리고 VBA로 셀서식도 지정할 수 있을까요?
예를 들어, 가운데 정렬 / 날짜 형식 / 회계형식 등을 지정할 수 있는지 궁금합니다.

회원등급 : 씨앗등급
포인트 : 49 EP
총질문 : 1 개 (마감율 : 100%)
채택답변 : 0 개
전체 4

  • 2021-07-06 12:29

    혹시 몰라서 VBA 명령코드도 같이 남겨드려요

    < 구매요구서 시트 > 구매요구서 시트(Sheet2)-> 집행내역(sheet1)으로 저장
    
    Option Explicit
    -------------------------------------------------------------------------------------------
    Function Get_접수번호()
    
        Dim cRow As Long
        Dim lastRow As Long
        
        With Sheet2
            lastRow = .Cells(.Rows.Count, 6).End(xlUp).Row
            For cRow = 5 To lastRow
            Get_접수번호 = .Cells(cRow, 6).Value
            Next
        End With
        
    End Function
    -------------------------------------------------------------------------------------------
    Sub 구매요구서_저장()
    
        Dim cntC As Double
        Dim str_Code As String
        Dim FindR As Double
        Dim rng As Range
        Dim rng1 As Range
        Dim lastRow As Double
        Dim i As Integer
         
        
        str_Code = Sheet2.Cells(5, 6).Value
        If str_Code = "" Then
            MsgBox "데이터를 입력해주시기 바랍니다.", vbCritical, ""
            Exit Sub
            
        Else
            lastRow = Sheet2.Cells(Rows.Count, 6).End(xlUp).Row
            For i = 5 To lastRow
          
            FindR = Find_direction(sheet1.Columns(1), str_Code, 1)
            If FindR = 0 Then
            FindR = sheet1.Cells(Rows.Count, 2).End(xlUp).Row + 1
            End If
    
            cntC = sheet1.Cells(2, Columns.Count).End(xlToLeft).Column
            Set rng = sheet1.Range(sheet1.Cells(1, 1), sheet1.Cells(1, cntC))
                   
            For Each rng In rng
                If rng.Value <> "" Then
                sheet1.Cells(FindR, rng.Column).Value = Sheet3.Cells(i, sheet1.Cells(1, rng.Column).Value).Value
                End If
            Next
            Next
         End If
          
        MsgBox "성공적으로 저장하였습니다.", vbInformation, ""
    End Sub
    ----------------------------------------------------------------------------------------
    < 모듈 >
    ----------------------------------------------------------------------------------------
    Sub 초기화()
    
        Rows("5:10000").Select
        Selection.ClearContents
        
    End Sub
    -------------------------------------------------------------------------------------------
    Sub 빈행삭제()
    
        Dim i, r, Counter As Integer
        Dim rngall As Range
        
        Application.ScreenUpdating = False
        Cells(10, 2).Select
        Set rngall = Range([D8], Cells(Rows.Count, 2).End(3))
        Counter = rngall.Rows.Count
        
        For i = 1 To Counter
            If ActiveCell.Value = "" Then
                Selection.EntireRow.Delete
                Counter = Counter - 1
                r = r + 1
            Else
                ActiveCell.Offset(1, 0).Select
            End If
        Next i
        If r = 0 Then
        MsgBox "빈 행이 없습니다."
        Else
        MsgBox "총" & r & "행을 삭제하였습니다."
        End If
    End Sub
    -------------------------------------------------------------------------------------------
    Sub 중복제거()
    
        Dim endrow As Long
        
        Range("$A$10:$Q$10000").Select
        Range("A10").Activate
        ActiveSheet.Range("$A$8:$Q$10000").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7 _
            , 8, 9, 10, 11, 12, 13, 14, 15, 16, 17), Header:=xlYes
    
        endrow = sheet1.Cells(Rows.Count, 1).End(xlUp).Row + 1
        sheet1.Cells(endrow, 1).Select
        
    End Sub
    -------------------------------------------------------------------------------------------
    Function Find_direction(Search_rng As Range, search_item As Variant, direction As Double)
    
        Dim rng As Range
        
        Set rng = Search_rng.Find(what:=search_item, lookat:=xlWhole)
        If Not rng Is Nothing Then
            Find_direction = IIf(direction = 1, rng.Row, rng.Column)
        Else
            Find_direction = 0
        End If
        
    End Function
    -------------------------------------------------------------------------------------------

    • 2021-07-06 12:45
      채택된 답변

      모듈을 직접 작성하신건가요? 직접 작성하신 거라면.. 이미 저보다도 잘 아시는 듯 해서 더 잘 해결하실 수 있을 것같습니다

      명령문 자체는 크게 문제가없어보이는데.. 아마도 시트에 기사용된 함수가 많아서 그런것이 아닐까(?) 생각합니다.

      구매요구서_저장이 메인 명령문으로 보이는데요.

      명령문을 아래 처럼.. 속도개선 하는 코드를 추가하면 많이 개선될 것 같습니다.

      Sub 구매요구서_저장()
      
          Dim cntC As Double
          Dim str_Code As String
          Dim FindR As Double
          Dim rng As Range
          Dim rng1 As Range
          Dim lastRow As Double
          Dim i As Integer
           
          
      Application.ScreenUpdating = False
      Application.Calculation = xlCalculationManual
      Application.EnableEvents = False
      
          str_Code = Sheet2.Cells(5, 6).Value
          If str_Code = "" Then
              MsgBox "데이터를 입력해주시기 바랍니다.", vbCritical, ""
              Exit Sub
              
          Else
              lastRow = Sheet2.Cells(Rows.Count, 6).End(xlUp).Row
              For i = 5 To lastRow
            
              FindR = Find_direction(sheet1.Columns(1), str_Code, 1)
              If FindR = 0 Then
              FindR = sheet1.Cells(Rows.Count, 2).End(xlUp).Row + 1
              End If
      
              cntC = sheet1.Cells(2, Columns.Count).End(xlToLeft).Column
              Set rng = sheet1.Range(sheet1.Cells(1, 1), sheet1.Cells(1, cntC))
                     
              For Each rng In rng
                  If rng.Value <> "" Then
                  sheet1.Cells(FindR, rng.Column).Value = Sheet3.Cells(i, sheet1.Cells(1, rng.Column).Value).Value
                  End If
              Next
              Next
           End If
      
      Application.ScreenUpdating = True
      Application.Calculation = xlCalculationAutomatic
      Application.EnableEvents = True
      
          MsgBox "성공적으로 저장하였습니다.", vbInformation, ""
      End Sub

       


      • 2021-07-08 13:07

        친절한 설명과 코드 안내 감사합니다!

        시트 내에 함수(VLOOKUP)도 많이 있었서 더 느렸던거 같아요.

         

        알려주신 코드로 변경해보고, 좀 더 고민해봐야겠네요! 감사합니다!


  • 2021-07-06 12:32


전체 3,474
번호 카테고리 제목 작성자 작성일 추천 조회
3461 문서서식
New 셀 병합 자동줄맞춤 문의 (2)
짱구는내친구 | 2021.07.25 | 추천 0 | 조회 34
짱구는내친구 2021.07.25 0 34
3460 문서서식
New 조건부서식 활용 (4) 답변완료
돌채 | 2021.07.25 | 추천 0 | 조회 40
돌채 2021.07.25 0 40
3459 기능/도구
New 데이터 유효성 검사에서 맨위 공란으로 표시되게 하려면 어떻게 해요? (2)
이하늘 | 2021.07.25 | 추천 0 | 조회 36
이하늘 2021.07.25 0 36
3458 함수/공식
New 조건 만족하는 함수식 첨부파일 (5) 답변완료
stranger | 2021.07.25 | 추천 0 | 조회 50
stranger 2021.07.25 0 50
3457 함수/공식
New [✨] 한 셀의 데이터를 구분자 기준으로 다수의 셀로 분리하고 싶습니다 첨부파일 (3)
milkcocoa | 2021.07.24 | 추천 0 | 조회 37
milkcocoa 2021.07.24 0 37
3456 VBA
New 괄호가 있는 셀의 색은 커운트하지 않는다. 첨부파일 (2)
돌채 | 2021.07.24 | 추천 0 | 조회 39
돌채 2021.07.24 0 39
3455 VBA
New 데이터 베이스 관련 첨부파일 (1)
까나리 | 2021.07.24 | 추천 0 | 조회 35
까나리 2021.07.24 0 35
3454 VBA
New 지우기 관련 (2)
까나리 | 2021.07.24 | 추천 0 | 조회 53
까나리 2021.07.24 0 53
3453 VBA
New 엑셀 로그인 시스템 관련 (3번 시도시 파일 강제종료부분)
지아 | 2021.07.23 | 추천 0 | 조회 49
지아 2021.07.23 0 49
3452 VBA
New VBA (제고관리프로그램) 공부하다가 문의가 있습니다. (7) 답변완료
까나리 | 2021.07.23 | 추천 0 | 조회 86
까나리 2021.07.23 0 86
3451 VBA
New 재고관리 프로그램 28강 켈린더의 BackStyle에 관한 질문입니다. (2) 답변완료
iviolin**** | 2021.07.23 | 추천 0 | 조회 34
iviolin**** 2021.07.23 0 34
3450 함수/공식
New 중복 값 찾기.. 첨부파일 (1)
인간 | 2021.07.23 | 추천 0 | 조회 41
인간 2021.07.23 0 41
3449 함수/공식
New 엑셀 데이터 정리관련 해서 질문합니다. 첨부파일 (1)
박정흠 | 2021.07.23 | 추천 0 | 조회 42
박정흠 2021.07.23 0 42
3448 VBA
New VBA SPLIT, FOR 함수 속도 문제 (9)
소람 | 2021.07.23 | 추천 0 | 조회 46
소람 2021.07.23 0 46
3447 기능/도구
New 도와주세요~ 시트 보호 해제 버튼이 비활성화 되어 해제가 되질 않아요 (3)
안개바다위의 쿳시 | 2021.07.23 | 추천 0 | 조회 46
안개바다위의 쿳시 2021.07.23 0 46
3446 VBA
FOR문 과 DO While 등 루프문 문의사항 첨부파일 (3) 답변완료
H.B | 2021.07.23 | 추천 1 | 조회 48
H.B 2021.07.23 1 48
3445 차트/그래프
슬라이서 차트의 범례 변경 (1)
전상준 | 2021.07.23 | 추천 0 | 조회 39
전상준 2021.07.23 0 39
3444 VBA
VBA로 구현하고 싶은데요 도와주세요... 첨부파일 (7) 답변완료
new_hwan | 2021.07.23 | 추천 1 | 조회 54
new_hwan 2021.07.23 1 54
3443 함수/공식
문자 연결 함수 문의 드립니다 (3)
세롱이 | 2021.07.23 | 추천 0 | 조회 47
세롱이 2021.07.23 0 47
3442 VBA
안녕하세요 질문좀 드려봅니다. (1)
엑셀공부 | 2021.07.23 | 추천 0 | 조회 32
엑셀공부 2021.07.23 0 32
3441 함수/공식
함수 질문 드립니다 첨부파일 (2)
ccha**** | 2021.07.23 | 추천 0 | 조회 32
ccha**** 2021.07.23 0 32
3440 피벗테이블
피벗테이블에서 값 필터 문제점 봐주세요 첨부파일 (1)
월마리아 | 2021.07.22 | 추천 0 | 조회 46
월마리아 2021.07.22 0 46
3439 VBA
VBA를 이용한 네이버 자동 로그인 이후 (3)
VBA이동머신 | 2021.07.22 | 추천 0 | 조회 45
VBA이동머신 2021.07.22 0 45
3438 함수/공식
시티를 비교해서 동일한 건 제거하는 것이 매일 반복되는데... 첨부파일 (5) 답변완료
Chris | 2021.07.22 | 추천 0 | 조회 41
Chris 2021.07.22 0 41
3437 VBA
VBA로 프린터 크기 지정관련 문제 첨부파일 (7) 답변완료
iviolin**** | 2021.07.22 | 추천 0 | 조회 38
iviolin**** 2021.07.22 0 38
3436 차트/그래프
원형차트에서 값이 변경될때마다 최대값의 조각만 따로 분리하는 해결방법 첨부파일 (2)
데이지 | 2021.07.22 | 추천 0 | 조회 35
데이지 2021.07.22 0 35
3435 VBA
셀 선택 시 연결된 함수 강조(색 변환) 첨부파일 (2) 답변완료
김세 | 2021.07.22 | 추천 0 | 조회 45
김세 2021.07.22 0 45
3434 기능/도구
구글 스프레드시트 데이터확인 범위에서의 목록 (1)
메꾸똘 | 2021.07.22 | 추천 0 | 조회 42
메꾸똘 2021.07.22 0 42
3433 함수/공식
다른 파일의 가로 DATA를 세로열로 부르는 방법 (DATA 호환 필요) 첨부파일 (8)
우롱쿠이 | 2021.07.22 | 추천 0 | 조회 64
우롱쿠이 2021.07.22 0 64
3432 함수/공식
구글 스프레드시트 쿼리로 전화번호 불러오기 (1)
메꾸똘 | 2021.07.22 | 추천 1 | 조회 40
메꾸똘 2021.07.22 1 40