728x90

같은 자료를 하나의 셀로 보여주도록 처리하는 VBA 코드이다.


첨부파일에는 여러개의 코드가 포함되어 있다.

VBA 고수분이 알려준 코드도 같이 포함되어 있고, 초보적인 수준으로 만든 코드도 포함되어 있다.


셀Join.xlsm


Sub collection2()
    Dim sht1, sht2 As Worksheet     '// 다른 시트 자료 가져오는 것까지 고려한 변수 선언
    Dim rngC, rngT, rngData As Range
    Dim X As New collection
    Dim r, n, i As Long
    Dim Dat As Variant

    Application.ScreenUpdating = False      '// 화면 업데이트 (일시) 중지
    Set sht1 = Sheets("Main")     '// 화면에 뿌릴 시트
    Set sht2 = Sheets("Data")   '// 가져올 데이터 시트
    Range("G2:H" & Cells(Rows.Count).Row).Offset(1).ClearContents   '// 결과를 뿌릴 화면 초기화
    Set rngData = sht2.Range(sht2.Cells(4, "B"), sht2.Cells(Rows.Count, "B").End(3))  '// 가져올 데이터 영역
  
    On Error Resume Next   '// 에러가 발생했을 경우 계속해서 다음을 실행하라
    r = 2
    For Each rngC In rngData    '// 데이터 시트의 B3셀부터 B의 마지막셀까지 반복하라
        X.Add rngC.Value, CStr(rngC.Value)      '// 중복된 데이터는 저장하지 마라
        If Err.Number <> 457 Then  '// 만일 에러가 발생하지 않았으면
            r = r + 1
            Cells(r, "G") = rngC
        End If
        Err.Clear
    Next rngC
   
    For Each rngT In Range([G3], Cells(Rows.Count, "G").End(3))
        ReDim Dat(1 To 1): n = 0   '// 배열 및 배열에 사용할 변수 초기화
        For Each rngC In rngData
            If rngC = rngT Then
                n = n + 1       '// 사용할 배열의 크기를 1씩 늘려감
                ReDim Preserve Dat(1 To n)   '// 기존값을 유지하면서 배열크기를 다시 설정
                Dat(n) = rngC.Offset(, 1)
            End If
        Next rngC
        rngT.Offset(, 1) = Join(Dat, ", ")
    Next rngT
    Set rngData = Nothing   '// 메모리 비우기
End Sub

728x90
블로그 이미지

Link2Me

,