유사한 내용을 기반으로 여러 Excel 행을 결합한 다음 VBA에서 열 증가

Question

워크시트의 모든 행을 확인한 다음 동일한 두 행을 결합한 다음 "QTY" 열을 증가시키는 VBA 루틴을 설정하려고 합니다.

다음은 제가 달성하고자 하는 것의 전후 예입니다.

---

전에:

---

후에:

---

나는 슈퍼유저와 인터넷의 다양한 곳에서 찾은 몇 가지 솔루션을 적용해 보았지만 불행하게도 여기에 직접 적용되는 것은 없으며 Excel의 VBA에 대한 제한된 이해로 인해 이 문제를 해결하는 데 방해가 됩니다.

Answer 1

이 코드를 모듈에 삽입하고 사용하기 전에 변수를 변경하세요.수량열당신이 가지고있는 열의 번호에수량제목:

Sub customgroup()
    Dim a As Application
    Dim wkb As Workbook
    Dim wks As Worksheet
    Dim DataRange As Range
    Set a = Application
    Set wkb = ThisWorkbook
    Set wks = wkb.Sheets(1)
    wks.Application.ScreenUpdating = False
    qtycolumn = 4 'this have to be changed to the QTY column
    reviewing = True
    visitrow = 1
    While reviewing = True
        visitrow = visitrow + 1
        If wks.Cells(visitrow, 1) = "" Then
            reviewing = False
        End If
        If wks.Cells(visitrow, qtycolumn) <> 0 Then
            countitems = 1
            visitrow2 = visitrow + 1
            reviewing2 = reviewing
            While reviewing2 = True
                If wks.Cells(visitrow2, 1) = "" Then
                    reviewing2 = False
                End If
                If wks.Cells(visitrow2, qtycolumn) <> 0 Then
                    compareranges = Join(a.Transpose(a.Transpose(wks.Rows(visitrow).Value)), Chr(0)) = Join(a.Transpose(a.Transpose(wks.Rows(visitrow2).Value)), Chr(0))
                    If compareranges = True Then
                        countitems = countitems + wks.Cells(visitrow2, qtycolumn)
                        wks.Cells(visitrow2, qtycolumn) = 0
                    End If
                End If
                visitrow2 = visitrow2 + 1
            Wend
            wks.Cells(visitrow, qtycolumn) = countitems
        End If
    Wend
    visitrow = visitrow - 1
    LastColumn = wks.Range("A1").CurrentRegion.Columns.Count
    Set DataRange = Range(Cells(1, 1), Cells(visitrow, LastColumn))
    lettercolumn = Split(Cells(, qtycolumn).Address, "$")(1)
    DataRange.Sort key1:=Range(lettercolumn & ":" & lettercolumn), order1:=xlDescending, Header:=xlYes
    For i = visitrow To 2 Step -1
        filterqty = wks.Cells(i, qtycolumn)
        If filterqty = 0 Then
            wks.Rows(i).Delete
        End If
    Next i
   wks.Application.ScreenUpdating = True
End Sub