VBA代码来合并重复的行并保持非空值？

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

这是一个链接到我的post在先生。 Excel的，但没有人可以找出解决scheme： https ： //www.mrexcel.com/forum/excel-questions/1014177-how-combine-rows-duplicate-info-into-one-based-column.html

这是一个前后的图像“

之前和之后的图像

关于如何使这个过程更高效的任何想法？ 我会认为VBA代码是必需的我目前正在做这个手动，这是非常痛苦的。 谢谢！

Answer 1

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”语句更改为有多less列:)

Answer 2

可能是这样的：

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

不记得确切..