2016-11-07 8 views
1

기본적으로 동일한 연속 ID에 대해 SUM 열을 병합하는 매크로를 만들려고합니다. 내가 정말 간단해야 믿는 열 C.VBA : 동일한 ID 번호를 가진 셀을 병합

ID QTY SUM > ID QTY SUM 
001 1 1 > 001 1  1 
002 2 5 > 002 2  5 
002 3 5 > 002 3  
003 4 4 > 003 4  4 

See Example

에 대한 (A2 = A3 A1 = A2) = OR : 조건부 서식에서 같은 것을 할 것이다.

고맙습니다.

+0

무엇을 시도 했습니까? 무언가를 시도한 다음 걸리면 다시 게시하십시오. 우리는 코드 작성 서비스가 아니지만, 문제가 생겨 도움이 필요할 때 도움을드립니다. – Sorceri

답변

0

이 작업을 수행해야합니다.

Option Explicit 

Private Sub MergeCells() 
' Disable screen updates (such as warnings, etc.) 
Application.ScreenUpdating = False 
Application.DisplayAlerts = False 

Dim rngMerge As Range, rngCell As Range, mergeVal As Range 
Dim i As Integer 
Dim wks As Worksheet 

Set wks = ThisWorkbook.Sheets("Sheet1") ' Change Sheet1 to your worksheet 

i = wks.Range("A2").End(xlDown).Row 
Set rngMerge = wks.Range("A2:A" & i) ' Find last row in column A 

With wks 
' Loop through Column A 
For Each rngCell In rngMerge 
    ' If Cell value is equal to the cell value below and the cell is not empty then 
    If rngCell.Value = rngCell.Offset(1, 0).Value And IsEmpty(rngCell) = False Then 
     ' Define the range to be merged 
     ' Be aware that warnings telling you that the 2 cells contain 2 differen values will be ignored 
     ' If you have 2 different sums in column C, then it will use the first of those 
     Set mergeVal = wks.Range(rngCell.Offset(0, 2), rngCell.Offset(1, 2)) 
     With mergeVal 
     .Merge 
     .HorizontalAlignment = xlCenter 
     .VerticalAlignment = xlCenter 
     End With 
    End If 
Next 
End With 

Application.DisplayAlerts = True 
Application.ScreenUpdating = True 
End Sub 
+0

위대한, 그것은 내 코드에 잘 작동합니다! 순전히 Niclas에게 감사하십시오. – Senzar

0

지금까지 나는 다음과 같은 코드를 사용했다 :

Sub MergeSum() 
    Set Rng = ActiveSheet.Range("A1:A5") 
    Dim nIndex As Long 
    Dim iCntr As Long 
    For iCntr = 1 To 5 
    If Cells(iCntr, 1) <> "" Then 
    nIndex = WorksheetFunction.Match(Cells(iCntr, 1), Rng, 0) 
    If iCntr <> nIndex Then 
    Let Obj = "C" & nIndex & ":" & "C" & iCntr 
    Range(Obj).Select 
    Application.DisplayAlerts = False 
    Selection.Merge 
    Application.DisplayAlerts = True 
    End If 
    End If 
    Next 
End Sub 

그러나이 코드는 한계가있다, 그것은 단지 상승하는 ID를 사용할 수 있습니다.

관련 문제