표 정리 VBA 질문 드립니다.

VBA
작성자
이종화
작성일
2024-10-12 21:02
조회
122
엑셀버전 : 엑셀2019

운영체제 : 윈도우11

질문 요약 : 표 작성을 하며 중간 공란을 해결 할 수 있는 VBA 자문

보통 순서대로 표를 작성하긴 하나 중간에 빠지는 경우 일일이 표를 옮겨서 공백이 없게 수동적으로 옮기는 작업을 자동으로 버튼하나로 하고싶어서 글 남겨봅니다.

-작동 후 원하는 모습입니다.

 

  • VBA능력이 한없이 부족하여 Chat GPT의 도움을 받아 다른기능같은 부분은 어느정도 보완하여 사용중이지만 이 기능만큼은 구현할수가 없어서 고수분들의 자문을 받고자 글 남깁니다 고견 부탁드립니다.

 

표는 2행부터 시작되며 1행은 메크로 버튼을 둘 자리입니다.

표의 크기는 1번 표를 예로 들어 A2:B2 = 이름칸(병합) A3:B9형태로 모두 크기는 동일합니다.

 

예시파일 첨부드립니다.  시트는 총 2개로 기본, 메크로 작동 후 (원하는모습) 입니다.

신고
스크랩
공유
전체 5

  • 2024-10-14 15:50

    @이종화 님 배워갑니다


  • 2024-10-12 22:49
    채택된 답변

    @이종화 님 기본 Array를 이용한 복사 방식으로 정리했고,
    서식을 유지하려면 셀복사 방식을 사용해야 하므로 별도 기재를 해 둡니다.

    첨부파일 : 환자평가표_메크로.xlsm


    • 2024-10-13 16:27

      @원조백수 님 선생님의 은혜에 깊은 감사를 표합니다.

      혹시 시간적 여유가 있으시다면 코드 설명 남겨주시면 감사히 정독하겠습니다.


      • 2024-10-14 09:42

        @이종화 님 프로세스는 이렇게 진행이 됩니다.
        1. Const 로 DataTotalColumns (전체열수), DataColumns(데이터 1개의 열수), DataRows(데이터 1개의 행수), DataStart(데이터 시작 행번호)를 지정해 둡니다.
        2. 현재 시트명에 "(정리)"를 추가한 시트가 있는지 확인해서 지우고, 현재 시트를 복사한 후 내용만 지웁니다(서식유지).
        3. 데이터 읽기 속도를 위해서 원본 시트의 데이터 영역을 배열로 복사합니다.
        4. 복사한 배열을 1번에서 정한 규칙대로 순환하면서 데이터 블럭이 유효한지 확인하고, 유효하면 idx 숫자를 하나씩 올려 Count합니다.
        5. 유효한 영역을 임시 배열로 복사해오고, idx에 따라 새로운 시트의 행/열번호를 확인하여 복사해 넣습니다.
        VBA에서는 범위를 정해서 값(Value, Value2)이나 수식(Formula, Formula2)을 배열로 복사하거나,
        반대로 2차원 배열을 그 크기에 맞는 범위에 일괄 입력할 수 있습니다.

        Sub RearrangeData()
            Dim sh1 As Worksheet, sh2 As Worksheet
            Dim vData As Variant, vCells As Variant, iR As Long, iC As Long, idx As Long
            '// 1번
            Const DataTotalColumns = 6, DataColumns = 2, DataRows = 8, DataStart = 2
         
            Application.ScreenUpdating = False
            Application.EnableEvents = False
            Set sh1 = ActiveSheet
         
            '// 2번
            If Evaluate("IsRef('" & sh1.Name & "(정리)'!A1)") Then
                Application.DisplayAlerts = False
                Worksheets(sh1.Name & "(정리)").Delete
                Application.DisplayAlerts = True
            End If
            sh1.Copy after:=sh1
            Set sh2 = ActiveSheet
            sh2.Name = sh1.Name & "(정리)"
            sh2.UsedRange.ClearContents
         
         
            '// 3번
            vCells = sh1.Range(sh1.Cells(1, 1), sh1.UsedRange.SpecialCells(xlCellTypeLastCell)).Value2
         
            '// 4번의 순환문
            For iR = DataStart To UBound(vCells, 1) Step DataRows
            For iC = 1 To DataTotalColumns Step DataColumns
                If Trim(vCells(iR, iC)) <> "" Then
         
                    '// 4번의 idx 숫자 증가
                    idx = idx + 1
         
                    '// 5번의 원본 임시 복사
                    vData = sh1.Cells(iR, iC).Resize(DataRows, DataColumns).Value2
                    '// 5번의 데이터 복사 
                    sh2.Cells(Int((idx - 1) / (DataTotalColumns / DataColumns)) * DataRows + DataStart, _
                    ((idx - 1) Mod (DataTotalColumns / DataColumns)) * DataColumns + 1).Resize(DataRows, DataColumns) = vData
         
                End If
            Next iC
            Next iR
            Application.EnableEvents = True
            Application.ScreenUpdating = True
         
        End Sub

         

         

         


  • 삭제된 댓글입니다.

전체 16,928
번호 카테고리 제목 작성자 작성일 추천 조회
알림
[📚진짜쓰는 실무엑셀] 2024년 엑셀 공부, 이 책 한권으로 마스터하세요! (290)
오빠두엑셀 | 2022.02.03 | 추천 554 | 조회 843938
오빠두엑셀 2022.02.03 554 843938
공지사항 문서서식
⭐ [더 나은 커뮤니티 문화를 위한 Q&A 글 작성 규칙] ⭐ (197)
오빠두엑셀 | 2021.10.28 | 추천 304 | 조회 31508
오빠두엑셀 2021.10.28 304 31508
74592 함수/공식
New 여러 값들 중에서 원하는 값을 찾고 싶어요 도와주세요! 첨부파일 (6) 답변완료
저도해볼게요 | 19:06 | 추천 0 | 조회 24
저도해볼게요 19:06 - 24
74589 구글시트
New 한셀에 줄바꿈으로 있는 여러데이터를 한셀에 한데이터 들어가게끔 일괄로 하고 싶습니다 첨부파일 (4) 답변완료
스톤스톤 | 18:21 | 추천 0 | 조회 23
스톤스톤 18:21 - 23
74585 VBA
New UserForm 크기질문 첨부파일 (3)
땡이 | 15:35 | 추천 0 | 조회 40
땡이 15:35 - 40
74583 함수/공식
New XLOOKUP 함수의 다중조건을 잘 모르겠습니다 첨부파일 (4)
qlcc**** | 14:58 | 추천 0 | 조회 46
qlcc**** 14:58 - 46
74582 함수/공식
New filter 함수에 대해 문의드립니다 (5)
김은상 | 14:45 | 추천 0 | 조회 47
김은상 14:45 - 47
74581 구글시트
New 구글폼 견적서 자동화 관련, 폼에서 입력된 이미지 파일을 견적서에 넣는 방법 좀 알려주시면 감사하겠습니다.
| 14:38 | 추천 0 | 조회 35
14:38 - 35
74572 차트/그래프
New 꺽은선 그래프의 레이블이 원복이 됩니다. 첨부파일 (3)
구리구리이 | 13:38 | 추천 0 | 조회 41
구리구리이 13:38 - 41
74570 함수/공식
New 배수 금액으로 순번 정하기 알려 주세요...ㅠ 엑셀파일첨부파일 (3)
서기 | 13:15 | 추천 0 | 조회 38
서기 13:15 - 38
74566 함수/공식
New 두개의 열에 입력된 데이터를 순서 바꿔서 입력으로 중복일 때 골라내는 법 엑셀파일첨부파일 (1)
문과적남자 | 12:35 | 추천 0 | 조회 39
문과적남자 12:35 - 39
74564 함수/공식
New 각 열별로 합 구하는 방법 첨부파일 (1)
라핼 | 11:13 | 추천 0 | 조회 50
라핼 11:13 - 50
74563 함수/공식
New 필터 적용시 중복값 제외 카운트 되는 법 좀 알려주세요 ㅠㅠ 첨부파일 (1)
정재욱 | 10:43 | 추천 0 | 조회 53
정재욱 10:43 - 53
74558 함수/공식
New 문자와 숫자가 섞여있는 열의 합계와 평균을 구하는 방법을 알려주세요!! 첨부파일 (9)
침착해 | 08:17 | 추천 0 | 조회 59
침착해 08:17 - 59
74556 함수/공식
New 세트상품 마진율 구하기 (2)
ek02 | 07:48 | 추천 0 | 조회 46
ek02 07:48 - 46
74543 기능/도구
New 문자와 숫자 혼합된 셀에서 숫자만 따로 따올수 있는 기능이 있을까요? 첨부파일 (3)
야만용사 | 2024.10.29 | 추천 0 | 조회 80
야만용사 2024.10.29 - 80
74542 기능/도구
New 엑셀 백분율 숫자로변경 (2)
rarara | 2024.10.29 | 추천 0 | 조회 68
rarara 2024.10.29 - 68
74540 함수/공식
New ★데이터 가공★ 잘못된 데이터를 올바른 데이터로 변환하는 과정을 도와주세요 ㅠㅠ 엑셀파일첨부파일 (9)
| 2024.10.29 | 추천 0 | 조회 101
2024.10.29 - 101
74539 함수/공식
New 안녕하세요 INDEX, MATCH 다중조건 질문드립니다! 엑셀파일 (3)
gys**** | 2024.10.29 | 추천 0 | 조회 80
gys**** 2024.10.29 - 80
74533 함수/공식
New 산출집계시트에 항목을 산출서에서 가져오고싶어요 엑셀파일 (3)
Moto | 2024.10.29 | 추천 0 | 조회 79
Moto 2024.10.29 - 79
74532 문서서식
New [질문] 전체 행 또는 열을 선택 후 특정 셀만 선택 제외 시키기 첨부파일 (2)
ViVaViva | 2024.10.29 | 추천 0 | 조회 68
ViVaViva 2024.10.29 - 68
74530 함수/공식
New Lookup 함수 오류에 관한 문의 엑셀파일첨부파일 (6) 답변완료
TMOH | 2024.10.29 | 추천 0 | 조회 80
TMOH 2024.10.29 - 80
74528 함수/공식
New 다중조건 만족하는 결과를 가져오고싶습니다 도와주세요 ㅠㅠ 엑셀파일첨부파일 (7)
말하지마00 | 2024.10.29 | 추천 0 | 조회 87
말하지마00 2024.10.29 - 87
74526 함수/공식
New 열과 행으로 정렬된 데이터를 같은 행으로 표시하려고 합니다. 엑셀파일 (2) 답변완료
깐부 | 2024.10.29 | 추천 0 | 조회 67
깐부 2024.10.29 - 67
74521 함수/공식
New B시트에서 A시트 항목 제품 및 수량 가져오는법좀 부탁드려요 첨부파일 (2)
Moto | 2024.10.29 | 추천 0 | 조회 69
Moto 2024.10.29 - 69
74520 VBA
New VBA 런타임 오류 관련 질문 첨부파일 (1)
angelriun | 2024.10.29 | 추천 0 | 조회 51
angelriun 2024.10.29 - 51
74518 함수/공식
New 두 시트에서 교집합 찾기 (3)
우파루파 | 2024.10.29 | 추천 0 | 조회 77
우파루파 2024.10.29 - 77
74516 구글시트
New 렌덤으로 배치 할수 있는 방법이 있을까요? 첨부파일 (8)
피망이 | 2024.10.29 | 추천 0 | 조회 67
피망이 2024.10.29 - 67
74513 함수/공식
New 엑셀로 명리를 정리하던 중에.. 엑셀파일 (7)
Ballad | 2024.10.29 | 추천 0 | 조회 94
Ballad 2024.10.29 - 94
74512 함수/공식
New 오빠두 강의인데 생각이 안나서 미치겠습니다. ㅠ (2)
Protoss | 2024.10.29 | 추천 0 | 조회 90
Protoss 2024.10.29 - 90
74496 함수/공식
New 두 개의 데이터를 매칭시켜야 하는데 방법을 모르겠습니다. ㅠㅠ 첨부파일 (3)
박진수 | 2024.10.28 | 추천 0 | 조회 97
박진수 2024.10.28 - 97
74495 파워쿼리/피벗
New 특정 기간 내 데이터만 파워쿼리로 병합하기 첨부파일 (3)
황남훈 | 2024.10.28 | 추천 0 | 조회 67
황남훈 2024.10.28 - 67