같은 셀

아질게 게시판에 엑셀 관련 조금 복잡한 질문의 내용들이 나오지 않아
심심하던 차에? 조금 복잡한 내용이 나왔네요.

http://www.clien.net/cs2/bbs/board.php?bo_table=kin&wr_id=3673755
하루종일 검색해보았지만 알 수 없었던 엑셀문제ㅠ 혹시 아시는 분 계실까요?

질문의 내용이 더 어려워 해석하느라 시간이 좀 걸렸습니다. 한 칼럼을 기준으로
같은 내용이 있으면 두 시트를 일정 방법으로 합쳐달라는 요지더군요.

간단히 VLOOKUP함수로 처리할 수도 있지만 저는 함수를 잘 활용하지 못하고
정형화된 내용은 VBA로 해결하는 사람이라 VBA로 짧은 코드 한번 짜 보았습니다.

Option Explicit

Sub Mergy_By_Same_Value()

Dim cnt As Integer, i As Integer

Dim rngCell As Range, rngTgt As Range
Dim rngR As Range, rngRef As Range

Dim tgt As Worksheet

‘ 경고 메시지 금지 및 속도를 위해 업데이트 중지
Application.DisplayAlerts = False
Application.ScreenUpdating = False

‘ 추출해서 붙여넣기할 데이터 시트가 기존에 있으면 삭제
For Each tgt In Worksheets
If tgt.Name = “ExtData” Then
tgt.Delete

End If
Next tgt

‘ 새 시트를 워크시트 제일 마지막에 ExtData라는 이름으로 추가
Set tgt = Worksheets.Add(after:=Worksheets(Worksheets.Count))
tgt.Name = “ExtData”

‘ 추출할 데이터 영역과 추출할 참조 영역 설정
Set rngTgt = Worksheets(“Alpha”).Range(“G:G”).SpecialCells(xlTextValues)
Set rngRef = Worksheets(“Beta”).Range(“G:G”).SpecialCells(xlTextValues)

‘ 두 영역을 순환하면서 같은 데이터가 있으면 추출 시트에 복사
For Each rngCell In rngTgt

For Each rngR In rngRef

If rngCell = rngR Then
‘셀 병합하여 붙여넣을 위치 결정
For i = 0 To 6
tgt.Range(“A1”).Offset(cnt, i * 2).Value = rngCell.Offset(0, i – 6).Value
tgt.Range(“A1”).Offset(cnt, i * 2 + 1).Value = rngR.Offset(0, i – 6).Value

Next i

cnt = cnt + 1

Exit For

End If

Next rngR

Next rngCell

‘ 보기 좋게 자동 칼럼 맞춤
‘ tgt.Columns.AutoFit

‘ 경고 메시지 및 업데이트 갱신
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

참조 : 20160309-같은 셀값 참조하여 두 시트 합침