VBA 문자열 변동 또는 합계에 따라 행 삽입/일련 번호

http://kin.naver.com/detail/detail.php?d1id=1&dir_id=1050202&eid=GAyTP/AXQwwVu6bQ3VKOsUWtyLATqcXH

 

	A	B	C	D
1	1	IMC101	I651-IB-S081/1	2
2	2	IMC101	I730-EC-101	2
3	3	IMC101	I730-EC-201	2
4	4	IMC101	I730-EC-301	2
5	5	IMC101	I730-EC-401	2

 

데이타가 위와 같이 A열 부터 위치할 때, 아무 데이타든지 클릭한 후 아래 매크로를 호출하면 됩니다.

 

----------------------------------

 

Sub 행_삽입_10()

    Dim i As Integer
    Dim j As Integer
    Dim k As Long
    Dim MySum As Integer
    Dim MyRow As Long
    Dim MyEnd As Long
    Dim Mystr As String

    ActiveCell.CurrentRegion.Select        '초기화
    MyRow = Selection.Rows(1).Row
    MyEnd = Selection.Rows.Count
    Mystr = Cells(MyRow, 2)
    i = 1: j = 0: k = 1
    Cells(MyRow, 5) = "'" & i & "-" & j
   
'Cells(3, 7) = "MyRow :" & MyRow    '데이타 확인용, 삭제해도 됨.
'Cells(3, 8) = "MyEnd :" & MyEnd
'Cells(3, 9) = "Mystr :" & Mystr
'Cells(3, 10) = "MySum :" & MySum
   
    GoTo 루프:
   
행_삽입:                                        '행 삽입 서브루틴
        MySum = Cells(MyRow, 4)                 '합계 초기화
        Cells(MyRow, 5) = "'" & i & "-" & j     '일련번호
        Rows(MyRow).Insert shift:=xlDown        '행 삽입
        MyRow = MyRow + 1                       '행 삽입된 만큼 현재 행 변동
        Return
           
루프:

    Do While k <= MyEnd                         'MyEnd 개수 만큼 루프 처리
        If Cells(MyRow, 2) = Mystr Then
            MySum = MySum + Cells(MyRow, 4)
                If MySum > 30 Then              '합계가 30을 넘었을 때
                    j = j + 1
                    GoSub 행_삽입
                End If
        Else                                    '문자열이 변했을 때
            Mystr = Cells(MyRow, 2)
            i = i + 1
            j = 0
            GoSub 행_삽입
        End If
        k = k + 1
        MyRow = MyRow + 1
   
    Loop
        
End Sub

 

----------------------------------

 

결과가 예시한 것과 약간 다르게 나오는데, 그건 예시표의 123, 125번 행 차이입니다. 말씀대로 간단할 것 같았는데...위에서부터 행을 삽입하며 처리하다 보니 데이타 수를 특정하는 것이 약간 힘들었습니다. 그리고 질문에서 '30미만'이라 적으신 것은 '30이하'로 해석해야 예시하신 표가 나옵니다. 즉, 위 루틴은 구간 합계가 30을 넘어야 새 구간으로 넘어갑니다. (2008.04.06)