| |
* 답변하시는 분들께 도움이 되도록 자신의 환경을 아래 항목 옆에 기재해 주세요.
- 엑셀 버전(95,97,2000,xp,2003,2007):2013
* 아래줄에 질문을 작성하세요 >>
1. A,B,C열(원본)은 놔두고
2. 품목을 같은거끼리 셀 병합 하고 [ (F:F)를 지정/ 나중에 변경가능]
3. 병합된 품목을 기준으로 병합된 금액의 성씨의 개수를 구하고 [ (G:G)를 지정/ 나중에 변경가능]
4. 병합된 품목을 기준으로 병합된 금액의 합을 구하고 싶습니다. [ (H:H)를 지정/ 나중에 변경가능]
5. 병합된 품목을 기준으로 NO을 나열 [ (E:E)를 지정/ 나중에 변경가능
6. 위 기능을 함수(FUNCTION)로 부탁드리며, 함수로 안되면 VBA로 부탁드립니다.
==============[정선택님 글에 대한 답변입니다]==============
첨부화일 참고하세요..
Sub UserMergeAndSum()
Dim sht As Worksheet
Dim rData As Range, rX As Range, rStart As Range
Dim rTg As Range
Dim sItem As String
Dim iNo As Integer, iCnt As Integer, iX As Integer
Dim lSum As Long
Set sht = ActiveSheet
With sht.Range("E1")
.CurrentRegion.Clear ' 타겟영역을 지우고
.Value = "NO"
sht.Range("A1").Resize(1, 3).Copy .Cells(1, 2)
Set rTg = .Offset(1) ' 타겟 지점을 새로 설정
End With
Set rX = sht.Range("A2")
Do While rX <> "" ' 품목이 널값이 아닐동안
If rX = rX.Offset(-1) Then
' 품목이 같은 값일 경우
iCnt = iCnt + 1
Else
' 품목이 같은 값일 아닐 경우
If iCnt > 0 Then
' 처음 시작 같은 품목의 갯수 확인을 위함
iNo = iNo + 1
Call writeCell(rStart, iNo, iCnt, rTg) ' 결과값을 기록
End If
Set rTg = rTg.Cells(iCnt + 1, 1)
Set rStart = rX
iCnt = 1
End If
Set rX = rX.Offset(1)
Loop
' 마지막 값을 기록하기 위함
iNo = iNo + 1
Call writeCell(rStart, iNo, iCnt, rTg)
dwkAutoHideMsg "처리 완료 하였습니다.", vbInformation, "결과///DewDrop", , 1000&
End Sub
Sub writeCell(rSoc As Range, iSeq As Integer, iSize As Integer, rTarget As Range)
With rTarget
With .Cells(1, 1).Resize(iSize, 1)
.Merge
.Value = iSeq
End With
With .Cells(1, 2).Resize(iSize, 1)
.Merge
.Value = rSoc
End With
With .Cells(1, 3).Resize(iSize, 1)
.Merge
.Value = WorksheetFunction.CountA(rSoc.Resize(iSize, 1).Offset(, 1))
End With
With .Cells(1, 4).Resize(iSize, 1)
.Merge
.Value = WorksheetFunction.Sum(rSoc.Resize(iSize, 1).Offset(, 2))
End With
End With
End Sub
|
|
엑셀에 대한 질문과
답변을 올려주세요. 단, 취지에 맞지 않는 글은 운영자가 삭제합니다.
