표 변환하기(셀삽입)

https://cafe.naver.com/excelmaster/160211의 질문입니다.

왼쪽 표를 오른쪽 표로 변환하는데

F는 각 목록별로 값을 가지고 있어서 셀을 삽입하는 것이 까다로웠습니다.

결국 순환문을 몇 번을 써서 해결했네요.

로직을 짜는 것이 모든 코딩의 어려운 점인 것 같습니다.

조금 더 고급진 코딩을 하고 싶은데

벽에 부딪힌 거 같네요.

질문.xlsm

Option Explicit
Option Base 1
Sub Macro()
 
    Dim FirstTable As Range
    Dim SecondTable As Range
    Dim SingleRange As Range
    Dim i As Integer
    Dim ToF As String
    
    Application.ScreenUpdating = False
    
    Set FirstTable = Range("A1").CurrentRegion  '첫번째 테이블
    With Range("F3")    '두번째테이블의 제목열
        Set SecondTable = Range(.Cells, .End(xlToRight))
    End With
    
    For Each SingleRange In SecondTable '두번째 테이블의 제목열 순환
    
        With FirstTable
        
            On Error Resume Next    '첫번째 테이블 필터 해제
                ActiveSheet.ShowAllData
            On Error GoTo 0
            
            .AutoFilter Field:=1, Criteria1:=SingleRange    '제목열 기준으로 첫번째 테이블 필터
            .AutoFilter Field:=4, Criteria1:="O"    '유의미성 O 필터
            
        End With
        
        ToF = IsMeaning(FirstTable.Columns(2))  '각 목록별 유의미성 추출
        Columns(SingleRange.Column).SpecialCells(2).Replace What:="F", _
                Replacement:=ToF, LookAt:=xlWhole    'F를 유의미성으로 바꾸기
        
    Next SingleRange
    
    Call MakeCells  '유의미성을 셀분할하여 각 셀에 삽입하는 프로시저 호출
    
    Application.ScreenUpdating = True
    
End Sub
 
Function IsMeaning(DataRange As Range) As String
'목록별 유의미성 추출
 
    Dim SingleRange As Range
    Dim v() As String
    Dim i As Integer
    Dim LoopRange As Range
    
    With DataRange  '필터링 되어 화면에 보이는 부분만 순환
        Set LoopRange = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(12)
    End With
    
    ReDim v(LoopRange.Cells.Count)
    
    For Each SingleRange In LoopRange   '유의미성을 배열에 삽입
    
        i = i + 1
            
        With SingleRange
            v(i) = .Value & "-" & .Offset(, 1)
        End With
    Next
        
    IsMeaning = Join(v, ",")
    ActiveSheet.ShowAllData
 
End Function
 
Sub MakeCells()
'셀 분할 후 유의미성 나누어 삽입하기
  
    Dim i As Integer
    Dim uB As Integer
    Dim SingleRange As Range
    Dim EachRange As Range
    Dim tmp() As Integer
    Dim j As Integer
    Dim a As Integer
    Dim ColumnCount As Integer
    Dim MaxUB As Integer
    
    '열 갯수(예시에서는 8개임(오징어~농어))
    ColumnCount = Range("F3").CurrentRegion.Columns.Count
    
    '밑에서 위로 순환하며 T가 아니면 셀삽입
    For i = Cells(Rows.Count, "F").End(3).Row To 5 Step -1
        
        j = 1
        With Cells(i, "F")
            Set EachRange = Range(.Cells, .End(xlToRight))
        End With
        
        For Each SingleRange In EachRange
            
            With SingleRange    '유의미성일 때 셀삽입할 칸수를 배열에 삽입
                If .Value <> "T" Then
                    uB = UBound(Split(.Value, ","))
                    ReDim Preserve tmp(j)
                    tmp(j) = uB
                    j = j + 1
                End If
            End With
            
        Next
        
        '유의미성이 있으면 셀 삽입
        If j > 1 Then
            
            MaxUB = WorksheetFunction.Max(tmp)  '총 늘릴 행 수
            Cells(i + 1, "F").Resize(MaxUB, ColumnCount).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            
            '같은 열을 한번 더 순환하며 빈칸 채우기
            For Each SingleRange In EachRange
            
                With SingleRange
                    Select Case .Value
                        Case "T"    'T일 때 T 채우기
                            .Resize(MaxUB + 1).Value = "T"
                        Case Else   '유의미성일 때 각 셀에 출력
                            .Resize(MaxUB + 1).Value = Application.Transpose(Split(.Value, ","))
                    End Select
                End With
                
            Next
            
        End If
        
    Next
    
    '선 긋고 열너비 자동 맞춤
    With Range("F5").CurrentRegion
        .Borders.LineStyle = xlContinuous
        .Columns.AutoFit
    End With
 
End Sub