| |
* 답변하시는 분들께 도움이 되도록 자신의 환경을 아래 항목 옆에 기재해 주세요.
- 엑셀 버전(95,97,2000,xp,2003,2007): 오피스2010
* 아래줄에 질문을 작성하세요 >>
성명을 기준으로 중복된 값을 제거한 후 대상금액은 합계로
응시과목 텍스트 합치기로 할 수 있는 방법이 있을까요?
==============[이미영님 글에 대한 답변입니다]==============
VBA로 만들었습니다.
첨부파일 참조하세요.
Sub getUserCondition()
Dim rData As Range, rX As Range
Dim rTg As Range
Dim colX As New Collection
Dim vX
Dim sKey As String
Dim iX As Integer
Dim vMoney(), vSubject()
Application.ScreenUpdating = False
Set rData = ActiveSheet.Range("A1").CurrentRegion
Set rTg = ActiveSheet.Range("A30") ' 타겟위치
rTg.CurrentRegion.Clear ' 기존 자료 삭제
rData.Rows(1).Copy rTg ' 필드항목 복사
Set rData = rData.Offset(1).Resize(rData.Rows.Count - 1) ' 필드항목 제외
On Error Resume Next
For Each rX In rData.Rows
'sKey = rX.Cells(1, 2) & rX.Cells(1, 3) & rX.Cells(1, 4) & rX.Cells(1, 5)
vX = rX.Cells(1, 2).Resize(1, 4).Value
sKey = Join(WorksheetFunction.Transpose(WorksheetFunction.Transpose(vX)), "/")
vX = rX.Resize(1, 5).Value
colX.Add vX, sKey
If Err.Number = 0 Then
iX = iX + 1
ReDim Preserve vMoney(1 To iX)
ReDim Preserve vSubject(1 To iX)
vMoney(iX) = rX.Cells(1, 6)
vSubject(iX) = rX.Cells(1, 8)
Else
vMoney(iX) = vMoney(iX) + rX.Cells(1, 6)
vSubject(iX) = vSubject(iX) & "/" & rX.Cells(1, 8)
Err.Clear
End If
Next
On Error GoTo 0
For iX = 1 To colX.Count
rTg.Cells(iX + 1, 1).Resize(1, 5) = colX.Item(iX)
rTg.Cells(iX + 1, 6) = vMoney(iX)
rTg.Cells(iX + 1, 8) = vSubject(iX)
Next
With rTg.CurrentRegion
.Columns.AutoFit
.Borders.LineStyle = xlContinuous
End With
Application.ScreenUpdating = True
End Sub
|
|
엑셀에 대한 질문과
답변을 올려주세요. 단, 취지에 맞지 않는 글은 운영자가 삭제합니다.
