행렬 변환 VBA 관련질문

VBA
작성자
H.B
작성일
2021-11-08 13:39
조회
48
엑셀버전 : M365

운영체제 : 윈도우10

안녕하세요.

수염그래프를 만들기위해 종을 횡으로 데이터 변환(Transpose)을 하도록 제 나름대로 vba를 작성해봤습니다(하기)

하지만, 한 횡에 데이터가 많고, 6개 부분을 나눠서 하나하나 변환하도록 만드니 너무 실행에 시간이 걸리네요....

 

혹시 한 횡의 여러 부분을 한번에 변환할수 있게(offset등을 써서??) 할수는 없을까요?

도움 부탁드립니다.

작성 vba 첨부파일 및 하기 참고

For i = lng To 5 Step -1

Range(Rows(i + 1), Rows(i + 1).Offset(3)).Insert Shift:=xlDown ' 4개 행 삽입

' +각 노란색 행부분을 행렬전환하여 넣은다음 불필요한 원래 열부분 데이터제거
Range(Cells(i, 4), Cells(i + 4, 4)).Value = Application.WorksheetFunction.Transpose(Range(Cells(i, 4), Cells(i, 4 + 4)).Value)
Range(Cells(i, 1 + 4), Cells(i, 4 + 4)).ClearContents

Range(Cells(i, 9), Cells(i + 4, 9)).Value = Application.WorksheetFunction.Transpose(Range(Cells(i, 9), Cells(i, 4 + 9)).Value)
Range(Cells(i, 1 + 9), Cells(i, 4 + 9)).ClearContents

Range(Cells(i, 14), Cells(i + 4, 14)).Value = Application.WorksheetFunction.Transpose(Range(Cells(i, 14), Cells(i, 4 + 14)).Value)
Range(Cells(i, 1 + 14), Cells(i, 4 + 14)).ClearContents

Range(Cells(i, 19), Cells(i + 4, 19)).Value = Application.WorksheetFunction.Transpose(Range(Cells(i, 19), Cells(i, 4 + 19)).Value)
Range(Cells(i, 1 + 19), Cells(i, 4 + 19)).ClearContents

Range(Cells(i, 24), Cells(i + 4, 24)).Value = Application.WorksheetFunction.Transpose(Range(Cells(i, 24), Cells(i, 4 + 24)).Value)
Range(Cells(i, 1 + 24), Cells(i, 4 + 24)).ClearContents

Range(Cells(i, 29), Cells(i + 4, 29)).Value = Application.WorksheetFunction.Transpose(Range(Cells(i, 29), Cells(i, 4 + 29)).Value)
Range(Cells(i, 1 + 29), Cells(i, 4 + 29)).ClearContents

Range(Cells(i, 34), Cells(i + 4, 34)).Value = Application.WorksheetFunction.Transpose(Range(Cells(i, 34), Cells(i, 4 + 34)).Value)
Range(Cells(i, 1 + 34), Cells(i, 4 + 34)).ClearContents

Range(Cells(i, 39), Cells(i + 4, 39)).Value = Application.WorksheetFunction.Transpose(Range(Cells(i, 39), Cells(i, 4 + 39)).Value)
Range(Cells(i, 1 + 39), Cells(i, 4 + 39)).ClearContents

'A~C열의 공통값 삽입된행 붙여넣기
Range(Cells(i + 1, 1), Cells(i + 4, 3)).Value = Range(Cells(i, 1), Cells(i, 3)).Value

Next i

전체 3

  • 2021-11-08 16:54
    채택된 답변

    처리 시간은 구형 삼성 RC420에서 약 5초 걸립니다.

    아래 Coding과 사진 및 첨부 파일 참조하세요.

    Sub myTranspose()

    Application.ScreenUpdating = False

    Dim myRng, myArr1, myArr2 As Variant
    Dim i, n, k, m, rcCount As Long

    Set myRng = Range("D5:H2662")

    myArr1 = myRng.Value

    rcCount = UBound(myArr1, 1) * UBound(myArr1, 2)

    ReDim myArr2(1 To rcCount) As Variant

    k = 1

    For i = 1 To UBound(myArr1, 1)

    For n = 1 To 5
    myArr2(k) = myArr1(i, n)
    k = k + 1
    Next
    Next

    For m = 1 To UBound(myArr2)
    Range(Cells(m + 4, 3), Cells(m + 4, 3)).Value = myArr2(m)
    Next

    Application.ScreenUpdating = True

    End Sub

    첨부파일 : 문의사항_답변.xlsm


  • 2021-11-08 18:35

    대단히 감사합니다.

    아, 정말 죄송합니다만 yukon님 그 제가원한건 노란색열을 하나로 합치는 게 아니라 상기그림처럼 각 노란색 영역에 붙여넣는거여서요 ㅠ 써주신 구문중 redim의 의미를 잘모르겠습니다만, 각 노란색 영역마다 행을 5개씩 삽입한후, 종으로 되있는 데이터를 횡으로 노란색 행에 삽입하는 방법이 없을까요.


  • 2021-11-08 19:27

    아 코드읽어보면서 대략적으로 이해했습니다 동일작업을 수회 반복하면 되겠군요 ㅎ 감사합니다. 나름대로 조금 변형해서 만들어보도록 하겠습니다.


전체 4,670
번호 카테고리 제목 작성자 작성일 추천 조회
공지사항 공지사항
⭐ [더 나은 커뮤니티 문화를 위한 Q&A 글 작성 규칙] ⭐ (10)
오빠두엑셀 | 2021.10.28 | 추천 16 | 조회 743
트로피 오빠두엑셀 2021.10.28 16 743
24233 함수/공식
New 0이상의 값(유효값)이 있는 칼럼과 그 값을 불러오고 싶습니다. 첨부파일
크놉스 | 11:41 | 추천 0 | 조회 3
크놉스 11:41 0 3
24232 차트/그래프
New 엑셀 차트에서 특정 값이 너무 높을때 차트화 하는 법
담담 | 11:36 | 추천 0 | 조회 5
담담 11:36 0 5
24230 VBA
New vba 코딩을 부탁드립니다. 첨부파일
Trimman | 11:09 | 추천 -1 | 조회 11
Trimman 11:09 -1 11
24228 함수/공식
New 등급 기준표를 참조해서 연산을 하려고 할때 (1) 답변완료
지천 | 10:12 | 추천 0 | 조회 16
지천 10:12 0 16
24221 파워쿼리/피벗
New 엑셀 종속 테이블 문의 첨부파일 (2)
유령회원 | 08:30 | 추천 0 | 조회 15
유령회원 08:30 0 15
24216 VBA
New 로그인엑셀 사용시 수식입력줄 사라짐, 모든 엑셀창 자동종료 첨부파일 (1)
엑셀이 | 00:19 | 추천 0 | 조회 16
엑셀이 00:19 0 16
24215 VBA
New set_routine 반복 매크로 (1)
하늘의 꿈 | 2021.12.01 | 추천 0 | 조회 19
하늘의 꿈 2021.12.01 0 19
24213 파워쿼리/피벗
New [파워쿼리] 계약자코드 중 특수계약 날짜가 일반계약 최소 최대 사이에 포함여부 열추가 첨부파일 (1)
seorin | 2021.12.01 | 추천 0 | 조회 18
seorin 2021.12.01 0 18
24211 VBA
New 시트를 메일머지하여 Hancom PDF 파일로 출력하는 매크로 VBA 코드 도움을 받고 싶어요. 첨부파일 (1)
김학동 | 2021.12.01 | 추천 0 | 조회 19
김학동 2021.12.01 0 19
24210 함수/공식
New 혹시 이런 것도 구할 수 있을까요? (3)
마른막대기 | 2021.12.01 | 추천 0 | 조회 27
마른막대기 2021.12.01 0 27
24207 함수/공식
New 중복값 중 제일 마지막 값 추출 (2)
rladud99 | 2021.12.01 | 추천 0 | 조회 34
rladud99 2021.12.01 0 34
24203 함수/공식
New 엑셀 값 가로/세로 변경하는 방법 문의드려요! 첨부파일 (2) 답변완료
이시현 | 2021.12.01 | 추천 0 | 조회 33
이시현 2021.12.01 0 33
24200 함수/공식
New 데이터를 일정간격으로 띄워서 입력하고 싶습니다. (5)
wlfl**** | 2021.12.01 | 추천 0 | 조회 43
wlfl**** 2021.12.01 0 43
24191 함수/공식
New 일치하는 값에 특정 데이터를 넣고싶습니다. (1)
노랑토끼 | 2021.12.01 | 추천 0 | 조회 51
노랑토끼 2021.12.01 0 51
24188 VBA
New VBA에서 이름이 긴 파일이 있는데 그 파일 이름을 바꾸고 싶습니다.(상세설명 필수) (2)
naver_618c988d51534 | 2021.12.01 | 추천 0 | 조회 28
naver_618c988d51534 2021.12.01 0 28
24184 문서서식
New 엑셀 자동채우기 관련 문의 (1) 답변완료
오문환 | 2021.12.01 | 추천 0 | 조회 39
오문환 2021.12.01 0 39
24182 함수/공식
New 줄바꿈 함수 도와주세요 첨부파일 (3)
김상준 | 2021.12.01 | 추천 1 | 조회 40
김상준 2021.12.01 1 40
24177 기능/도구
New 매크로 와 자동필터
FLOWERBALL | 2021.11.30 | 추천 0 | 조회 46
FLOWERBALL 2021.11.30 0 46
24168 VBA
New (문의) 번호가 같을경우 옆에 있는 셀의 값을 병합 (1)
ryan_cruze | 2021.11.30 | 추천 0 | 조회 42
ryan_cruze 2021.11.30 0 42
24166 기능/도구
New 질문있습니다.
최강씨맨 | 2021.11.30 | 추천 0 | 조회 34
최강씨맨 2021.11.30 0 34
24163 함수/공식
New 엑셀 특정 내용 추출하는 수식 질문드립니다. (2)
PAKSAW | 2021.11.30 | 추천 0 | 조회 48
PAKSAW 2021.11.30 0 48
24161 함수/공식
New 특정 날짜 값 찾기 (2)
ㄱ박민극 | 2021.11.30 | 추천 -1 | 조회 45
ㄱ박민극 2021.11.30 -1 45
24154 피벗테이블
New 설문조사 피벗테이블 구성이 어렵네요 첨부파일 (3)
가리 | 2021.11.30 | 추천 0 | 조회 37
가리 2021.11.30 0 37
24153 VBA
New 엑셀 검색 창 첨부파일 (2)
이혜 | 2021.11.30 | 추천 0 | 조회 36
이혜 2021.11.30 0 36
24148 피벗테이블
New 피벗테이블 형태의 데이터베이스 변환 (1)
이길호 | 2021.11.30 | 추천 0 | 조회 32
이길호 2021.11.30 0 32
파워쿼리/피벗
New Re:피벗테이블 형태의 데이터베이스 변환
Yukon | 2021.11.30 | 추천 0 | 조회 22
Yukon 2021.11.30 0 22
24140 VBA
New 특정 시트에 추출되어있는 값을 각각의 시트로 분류하려고합니다. 첨부파일 (1)
이치영 | 2021.11.30 | 추천 0 | 조회 44
이치영 2021.11.30 0 44
24135 VBA
New vlookup #N/A 에러가 나오는 경우 IF문은 어떻게.... (2)
툴잇지 with 우정기기 | 2021.11.29 | 추천 0 | 조회 59
툴잇지 with 우정기기 2021.11.29 0 59
24132 함수/공식
New 동적범위, 셀값을 시트명으로 인식하여 합계를 구하는것 첨부파일 (6) 답변완료
키큰아저씨 | 2021.11.29 | 추천 0 | 조회 58
키큰아저씨 2021.11.29 0 58
24129 VBA
New 직사각형 도형 삭제vba (2) 답변완료
H.B | 2021.11.29 | 추천 1 | 조회 35
H.B 2021.11.29 1 35
24126 VBA
New "요청한 레지스트리에 엑세스할 수 없습니다." 라는 에러때문에 진행이 안됩니다. (3)
볼펜수리공 | 2021.11.29 | 추천 0 | 조회 35
볼펜수리공 2021.11.29 0 35