VBA代码合并重复行并保持非空值?

时间:2017-07-14 14:54:17

标签: excel vba merge duplicates

我正在寻找一种更有效的方法来合并重复行,具体取决于列名“Product”。某些行不会有重复项。以下是我正在使用的数据示例。实际上,我正在处理数千个这样的行和超过40列。如果根据“Product”列确定存在重复行,我的目标是合并为一行并保留非空值。

这是我在先生的帖子的链接。 excel,但没有人能找到解决方案:https://www.mrexcel.com/forum/excel-questions/1014177-how-combine-rows-duplicate-info-into-one-based-column.html

这是“

之前和之后的图像

image of before and after

有关如何提高此流程效率的任何想法?我认为VBA代码是必需的,我目前正在手动执行此操作,这非常痛苦。谢谢!

2 个答案:

答案 0 :(得分:0)

可能是这样的:

dim rRange as Range
Set rRange = Application.InputBox('', '' , Type:=8)

不记得确切..

答案 1 :(得分:0)

Sub compareLines()

'Set selected cell to starting position Row 2 Column A
ActiveSheet.Cells(2, 1).Select

'Stopping the application updating the screen while the macro is running which can significantly increase the speed of vba 
Application.ScreenUpdating = False

'Loop to keep macro running into it reaches the last 'Product'
While ActiveCell.Value <> ""

    'Check whether the product name in the next row is the same as the product in the current row    
    If ActiveCell.Value = ActiveCell.Offset(1, 0).Value Then

        'Keep going until you reach the 40th column(change this to what u need)
        For i = 2 To 40

        'Checks whether the next column is blank
        If ActiveCell.Offset(0, i).Value = "" Then

            'If the column is in fact blank then copy the value of the row below
            ActiveCell.Offset(0, i).Value = ActiveCell.Offset(1, i).Value

        End If
        'move to next column
        Next

    'Once the last column has been reached, delete the duplicate row
    ActiveCell.Offset(1, 0).EntireRow.Delete

    'If product below isn't the same as the current product
    Else

    'Then move to the next row
    ActiveCell.Offset(1, 0).Select

    End If

Wend

'turning this back on so you can see the changes
Application.ScreenUpdating = True

End Sub

将“For”语句更改为您拥有的列数:)