VBA代码合并重复行并保留非空值？

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

这里是我的帖子在先生的链接。 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代码后”？。需要我目前手动这样做，这是非常痛苦的谢谢

来源

2017-07-14 astro45

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”语句给你多少列有:)

来源

2017-07-14 15:13:21

您好基兰，这对我的作品，但你不介意解释每一行做什么。我是VBA的初学者。 – astro45

当然，我从原始答案中评论了我的代码。如果它适用于您，您能否将其标记为正确答案？干杯 –

可能是这样的：

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

不记得确切..

来源

2017-07-14 15:00:35

VBA代码合并重复行并保留非空值？

回答

相关问题