Excel VBA - 在一个单元格中组合具有重复值的行，并在其他单元格中合并值 [英] Excel VBA - Combine rows with duplicate values in one cell and merge values in other cell

问题描述

我试图在一列中找到重复的值，并将第二列的值合并成一行。我也想在第三列中加总值。

I am trying to find duplicate values in one column and combine the values of a second column into one row. I also want to sum the values in a third column.

例如：

A    B    C    D
h    4    w    3
h    4    u    5
h    4    g    7
h    4    f    4
k    9    t    6
k    9    o    6
k    9    p    9
k    9    j    1

将成为

A    B    C        D
k    9    t;o;p;j  22
h    4    w;u;g;f  19

我第一部分使用的代码是

The code I have been using for the first part of this is

 Sub mergeCategoryValues()
Dim lngRow As Long

With ActiveSheet

lngRow = .Cells(65536, 1).End(xlUp).Row

.Cells(1).CurrentRegion.Sort key1:=.Cells(1), Header:=xlYes 
Do

    If .Cells(lngRow, 9) = .Cells(lngRow + 1, 9) Then
        .Cells(lngRow, 11) = .Cells(lngRow, 8) & "; " & .Cells(lngRow + 1, 8)
        .Rows(lngRow +1).Delete
    End If

    lngRow = lngRow - 1

Loop Until lngRow < 2

End With

End Sub

（请原谅缩进）

我遇到的问题是它会找到第一对副本，但不是全部。所以我得到的结果如下：

The problem that I am running into is that it will find the first pair of duplicates, but not all. So I get a result that looks like this:

A    B    C    D
k    9    t;o  12
k    9    p;j  10   
h    4    w;u  8
h    4    g;f  11

思考？

提前谢谢。

推荐答案

尝试将代码更改为这个：

Try changing your code to this:

Sub mergeCategoryValues()
    Dim lngRow As Long

    With ActiveSheet
        lngRow = .Cells(65536, 1).End(xlUp).Row
        .Cells(1).CurrentRegion.Sort key1:=.Cells(1), Header:=xlYes

        Do
            If .Cells(lngRow, 1) = .Cells(lngRow - 1, 1) Then
                .Cells(lngRow - 1, 3) = .Cells(lngRow - 1, 3) & "; " & .Cells(lngRow, 3)
                .Cells(lngRow - 1, 4) = .Cells(lngRow - 1, 4) + .Cells(lngRow, 4)
                .Rows(lngRow).Delete
            End If

            lngRow = lngRow - 1
        Loop Until lngRow = 1
    End With
End Sub

---

测试

---

Tested

编辑

为了使其更容易调整到不同的列，我在开始时添加了变量来指示哪个列做了什么。请注意，当前逻辑中不使用列2（B）。

To make it a little easier to adjust to different column I added variables at the beginning to indicate which column do what. Note that column 2 (B) isn't used in the current logic.

Sub mergeCategoryValues()
    Dim lngRow As Long

    With ActiveSheet
        Dim columnToMatch As Integer: columnToMatch = 1
        Dim columnToConcatenate As Integer: columnToConcatenate = 3
        Dim columnToSum As Integer: columnToSum = 4

        lngRow = .Cells(65536, columnToMatch).End(xlUp).Row
        .Cells(columnToMatch).CurrentRegion.Sort key1:=.Cells(columnToMatch), Header:=xlYes

        Do
            If .Cells(lngRow, columnToMatch) = .Cells(lngRow - 1, columnToMatch) Then
                .Cells(lngRow - 1, columnToConcatenate) = .Cells(lngRow - 1, columnToConcatenate) & "; " & .Cells(lngRow, columnToConcatenate)
                .Cells(lngRow - 1, columnToSum) = .Cells(lngRow - 1, columnToSum) + .Cells(lngRow, columnToSum)
                .Rows(lngRow).Delete
            End If

            lngRow = lngRow - 1
        Loop Until lngRow = 1
    End With
End Sub

这篇关于Excel VBA - 在一个单元格中组合具有重复值的行，并在其他单元格中合并值的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！