엑셀 지정한 행까지 끊어서 여러파일로 저장하기

Profile
hyogle
재생하기

고도몰5 쇼핑몰 솔루션을 친애하는 나였지만 대량등록이 200개도 넘기기 힘듭니다.  셀내용이 많으면 오류가 더 많이 나지요

이래서 무슨 대량등록이라고 할 수 있겠습니까?

답답한 노릇이죠


5000개의 상품을 대량등록으로 진행하려면 25번 이상의 단순 노가다가 발생됩니다. 시간이 금인데 그들은 우리의 시간을 헛되게 합니다. 그래서 시간을 아껴보고자 검색 들어갔지요


http://blog.naver.com/jsk005/150180850094

[VBA] 지정한 행만큼씩 나눠서 파일로 저장하기 엑셀파일을 다루다 보면 지정한 행만큼씩 파일로 분리하...


자세한 설명과 함께 파일까지 올려두셨습니다. 

파일을 헤집어보면 다음과 같습니다. 


Option Explicit


Sub split_As_per_Rows()

    ' 지정한 행만큼씩 파일을 나눠서 저장하는 VBA

    Dim rngAll As Range                           '모든 영역을 저장할 변수

    Dim SplitLine As Integer                      '몇 행씩 나눌지를 정하는 변수

    Dim rowsCount As Long, colsCount As Integer   '행 및 열의 갯수 저장할 변수

    Dim strPath As String                         '파일저장 경로를 넣을 변수

    Dim i As Long                                 '반복구문 숫자 증가에 사용할 변수

    Dim rowsNo As Long                            '행 증가에 사용할 변수

    Dim rngSplit As Range                         '나누어진 영역을 저장할 변수

    Dim strName As String

 


    Application.ScreenUpdating = False      '화면 업데이트 (일시)정지

    Set rngAll = ActiveSheet.UsedRange      '사용전체영역을 변수에 넣음

    SplitLine = 5000                        '이 숫자대로 파일이 나누어지므로 이 숫자를 원하는 만큼 변경하여 사용하면 됨

    rowsCount = rngAll.Rows.Count           '전체 행의 숫자를 행 변수에 넣음

    colsCount = rngAll.Columns.Count        '전체 열의 숫자를 열 변수에 넣음

    strPath = ThisWorkbook.Path & Application.PathSeparator   '저장 경로로 현재 파일이 있는 경로에 저장

    

    With ThisWorkbook

      strName = Left(.Name, Len(.Name) - 5)  'Excel 파일의 확장자 제거. 만약 xls 파일이면 숫자를 4로 변경

    End With

    

    For i = 2 To rowsCount Step SplitLine                                     'SplitLine 만큼씩 증가하며 반복

        rowsNo = i + SplitLine                                                 '행도 지정한 SplitLine 만큼씩 증가

        Set rngSplit = Range(Cells(i, 1), Cells(rowsNo + 1, colsCount))         '나누어진 영역을 변수에 넣음

        Workbooks.Add                                                         '새로운 workbook을 생성

        rngAll.Rows(1).SpecialCells(2).Copy Cells(1, 1)                         '첫줄 제목을 각 workbook에 복사

        Range(Cells(2, 1), Cells(SplitLine + 1, colsCount)) = rngSplit.Value '2번째 행부터 나누어진 영역(SplitLine 만큼)을 복사


        Columns.AutoFit  '열너비 자동맞춤

        ActiveWorkbook.SaveAs strPath & strName & "(" & ((i - 1) \ SplitLine) + 1 & ").xlsx", FileFormat:=xlOpenXMLWorkbook

                               '현재 파일이 있는 경로에 현재파일명 + SplitLine 만큼씩 나눠서 몫으로 카운트하면서 저장

        ActiveWorkbook.Close   '새로 만든 workbook을 저장

    Next i

   

    Set rngAll = Nothing     '개체변수들 초기화(사용 메모리 비우기)

    Set rngSplit = Nothing

End Sub


알아보기 힘든 명령어지만 하나하나 뜯어보면 그 의미를 알수 있습니다.

카쎈님들 화이팅!





Profile
hyogle Level. 28 74870/75690

^^

댓글
1
  • hyogle
    작성자
    2020.06.17
    비밀글입니다.

    비밀번호를 입력하세요.

Profile
번호 제목 글쓴이 날짜 조회 수
963 뉴 엑센트(11~)차량 리어 브레이크패드 아반떼MD와 동일 사용 profile hyogle 2019.01.07 178
962 쏘나타·투싼·벨로스터 정기구독 하시겠습니까? profile hyogle 2019.01.08 91
961 365일간 느낀 F10 520D 오너의 차량 잡소리 썰 profile hyogle 2019.01.09 1125
960 블랙베리, 자동차용 ‘디지털 콕핏 솔루션’ 출시 profile hyogle 2019.01.09 17
959 플리어, 자율주행차용 2세대 열상 카메라와 자동차 정비용 휴대형 열상 카메라 발표 profile hyogle 2019.01.09 31
958 자율주행차 안전성 믿을 수 있나…한국 소비자 절반 “우려” profile hyogle 2019.01.09 25
957 “자동차와 TV의 미래, 우리가 보여줄게” profile hyogle 2019.01.09 19
956 2018 메르세데스 벤츠 전세계 프리미엄브랜드 1위 달성 profile hyogle 2019.01.09 59
955 벤츠 E300 AV 왜 잘팔리나 했더니 profile hyogle 2019.01.09 1357
954 올뉴말리부 프론트범퍼의 그릴을 북미형으로 개조하는 영상 .TUBE profile hyogle 2019.01.09 255
953 일반 [CES 2019] 하만, 미래 자동차 위한 첨단 커넥티드 카 기술 선봬 profile hyogle 2019.01.10 20
952 각종 키, 휠볼트커버, 플라스틱 부품 전문 판매점 .알리바바 profile hyogle 2019.01.10 343
951 휠볼트 안풀릴 때 식겁했는데 이런 공구 있으면 괜찮겠네요 profile hyogle 2019.01.10 1765
950 자동차, 흰색은 세계적인 컬러 profile hyogle 2019.01.11 37
949 젠슨 황 “자동차는 AI가 적용된 첫번째 로봇 될 것” profile hyogle 2019.01.11 22
948 아마존 인공지능 '알렉사', 자동차 속으로 들어간다 profile hyogle 2019.01.11 14
947 기억속으로 사라진 인기있었던 자동차 모델 14선 profile hyogle 2019.01.11 20
946 도요타, 에어백 결함 북미지역서 170만대 리콜 profile hyogle 2019.01.11 21
945 현대차, ‘코나 아이언맨 한정판’ 국내 1700대 판매 profile hyogle 2019.01.11 29
944 추운 겨울날, 자동차 히터 성능을 백배 극대화해서 사용하자! profile hyogle 2019.01.11 30

로그인

모바일로 접속하세요.
서버에 요청 중입니다. 잠시만 기다려 주십시오...