[vba] 같은 조건의 문자열 찾아 합치기 (매크로버전)

지난번에 몇번 올라왔던 사용자 정의함수의 매크로 버전이다. 어떤 분이 엑셀이 느려진다고 해서 만들어보았다.

속도 자체는 크게 다르지 않은 것 같다. 아무래도 전체 셀을 순환해야하니까....

그래도 사용자정의함수였을 때는 셀에 다른 입력을 하거나하면 새로 계산을 하느라 버벅였는데

지금은 결과값이 수식이 아니라 텍스트로 입력이 되기 때문에, 새로 계산을 하지 않는다.

그 점은 더 나아진 것 같다.

Option Explicit

Sub CText()

Dim strTemp() As String

Dim rng1 As Range

Dim rng2 As Range

Dim rng3 As Range

Dim r1 As Range

Dim rr1 As Range

Dim i As Integer, n As Integer, k As Integer

Set rng1 = Application.InputBox("일치할 값이 있는 범위 선택", "Index", , , , , , Type:=8)

Set rng2 = Application.InputBox("합칠 텍스트 범위 선택", "text", , , , , , Type:=8)

Set rng3 = Application.InputBox("합친 텍스트가 표시될 범위 선택", "to show", , , , , , Type:=8)

n = rng2.Column - rng1.Column   '인덱스와 텍스트사이의 거리

k = rng3.Column - rng1.Column   '인덱스와 표시장소사이의 거리

    For Each r1 In rng1

        ReDim strTemp(i)                     '문자열 배열 초기화

    

            For Each rr1 In rng1

                If r1 = rr1 Then

                ReDim Preserve strTemp(i)              '이전 입력된 문자열 유지한채로 새로운 문자열 추가

                strTemp(i) = rr1.Offset(, n).Value

                i = i + 1                                     '배열 값 추가

                End If

            Next rr1

       r1.Offset(, k).Value = Join(strTemp, "/")

       i = 0                                                  '배열 크기 초기화

     Next r1   

End Sub

1행의 내용이 뒤에서 또 나오면 한번더 전체 순환하지 않고 위에서 나온 결과값으로 기록하는 부분을 넣으려했는데, 

코드가 이래저래 복잡해져서 포기했다.