[기초방] VBA 100제 #38 [ 재배치하기 ]

 

최근에 기초 문제가 난이도가 너무 높다고 해서 문제의 난이도를 낮춰보았다.

물론 난이도라는게 내가 한번이라도 해보거나 경험하였다면 그또한 쉬운 문제일것이다.

 

문제를 많이보고 많이 풀어보는 수밖에 없다...

기초방을 함께 하는 크루들의 실력이 상향 평준화 됨에 따라 본인의 자리가 작아짐을 느끼지만 그것또한

본인의 기쁨이리라...

For Each rngA In rngall
    
    If rngA = rngall(1) Then rngA(1, 6).Resize(1, 5) = Array("영업자", "시간", "제품명", "배송지", "가격")
   
Next rngA

if rngA = rngAll(1) : 첫번째 행 / 즉 머릿말을 의미한다.

 

For Each rngA In rngall
       
    If IsDate(rngA) Then                                        '= 날짜 형식이면
       R = R + 1                                                '= 행값(R)을 +1증가시켜라
       Cells(Rows.Count, "i").End(3)(2) = rngA(1 - R, 1)        '= 이름
       rngA.Resize(1, 4).Copy Cells(Rows.Count, "j").End(3)(2)  '= 이름에 관련된 데이터
    Else: R = 0												
    End If

Next rngA

If IsDate(rngA) then : 형식이 날짜 형식이면, R값을 증가시키면서 영업자 이름의 위치를 고정하는 역할을 한다.

 

나머지 부분은 딜레이를 줄거나 서식효과를 주기위한 코드임으로 부가 설명을 줄이도록 하겠다.

 

같은 크루들의 코드를 소개하면 우선 딱총님의 코드를 소개하겠다..

영역을 SpecialCells(2,1) - 데이터중 숫자인 셀.....[ 본인의 IsDate 함수의 대체라 생각된다.. ]

연속된 범위가 아니면 SpecialCells(2,1)로 구분한 영역들이 뚝뚝 떨어지기 때문에 반복문으로 컨트럴하기 힘들기 때문에 해당영역들을 Areas로 묶어서 순환하는 코드이다.. 

 

음 역시 고급스럽다.

 

다음은 이번에 이쁜 딸을 얻은 딸바보 무지님의 코드이다.

38-1 문제의 열의 위치를 변경하는 부분을 고급필터로 처리하였다..  이 코드는 생각도 못한 코드이다.

또 한수 배움의 장이 되어 버렸다.

Option Explicit

Sub 기초방_38()

    Dim rngall As Range: Set rngall = [d5:d28]                      '= 데이터 영역
    Dim rngA As Range
    Dim R&, bln As Boolean
    
    haja_format bln                                                 '= 초기화
    
    For Each rngA In rngall
    
        If rngA = rngall(1) Then rngA(1, 6).Resize(1, 5) = Array("영업자", "시간", "제품명", "배송지", "가격")
       '= 말머리이면 제목행을 넣어라
                                                                    
        If IsDate(rngA) Then                                        '= 날짜 형식이면
           R = R + 1                                                '= 행값(R)을 +1증가시켜라
           Cells(Rows.Count, "i").End(3)(2) = rngA(1 - R, 1)        '= 이름
           rngA.Resize(1, 4).Copy Cells(Rows.Count, "j").End(3)(2)  '= 이름에 관련된 데이터
        Else: R = 0
        End If
    
    Next rngA
  
    Set rngall = [i5].CurrentRegion                                 '= 전체 영역 재설정
    
    haja_format bln, rngall
    
    Application.Wait Now + TimeSerial(0, 0, 2)                      '= 2초 일시정지
    
    Columns("n").ColumnWidth = 3                                    '= N열 축소
    
    rngall.Copy [o5]                                                '= 38-1 문제 해법
    
    Columns("p").Cut                                                '= 잘라내기
  
    Columns("r").Insert Shift:=xlToRight                            '= 오른쪽으로 밀어내고 삽입
    
    
    haja_format bln, rngall
    
End Sub

Function haja_format(bln As Boolean, Optional rngall As Range)
    
    If bln = False Then
    
        Columns("i:s").Delete
        bln = Not bln
    
    Else
        rngall.Borders.LineStyle = 1
        
        With Columns("i:s")
            .AutoFit
            .HorizontalAlignment = xlCenter
        End With
        
    End If
    
    
End Function

같은 문제를 풀면서 이렇게 다양한 코드가 나오면 참 기분이 좋다...

더 발전된 엑사남들의 오늘을 응원한다.

기초방 38.xlsm

0.03MB