VBA代码 – 结合excel行与负数

我试图从这里得到一个Excel表：（对不起，我的声望不够高，无法发布图片，所以自己托pipe）

从这个例子

至

这个。

我有一些我发现和修改的VBA代码：

pipe理这些excel表单的女孩不会按帐号进行预先分类，就像我在上面的第一个屏幕截图中所做的那样，也是在下面的代码中

Sub MergeRows() Dim iRow As Long, oCell As Object Sheets(1).Activate Columns("A:H").Select Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortTextAsNumbers iRow = 1 Do While Len(Cells(iRow, 1)): DoEvents If Cells(iRow, 1) = Cells(iRow + 1, 1) Then For Each oCell In Rows(iRow).Cells If oCell < Cells(iRow + 1, oCell.Column) Then oCell = Cells(iRow + 1, oCell.Column) End If Next Rows(iRow + 1).Delete Else iRow = iRow + 1 End If Loop End Sub 

但是，那

 If oCell < Cells(iRow + 1, oCell.Column) Then 

行似乎导致负数被删除，因为他们不大于他们上面的空白单元格。 （对吧？），我找不到解决schemeA）不删除负数和B）不需要一个小时运行。

我已经尝试换行：

 If Len(Trim(oCell)) = 0 Then 

但是，当你进入100多行账户时，需要很长时间。

有没有其他方法可以sorting，然后结合行而不会失去负面影响或需要一个小时运行？

我敢肯定，这是一个简单的解决scheme..但我是新的VBA代码。

谢谢，

Answer 1

这段代码不需要对数据进行sorting，并且会正确地保留底片。 它应该运行得相当快：

 Sub MergeRows() Dim ws As Worksheet Dim rngUnqAccts As Range Dim arrData() As Variant Dim arrResults() As Variant Dim rIndex As Long Dim cIndex As Long Dim ResultIndex As Long Set ws = Sheets(1) With ws.Range("A2", ws.Cells(ws.Rows.Count, "A").End(xlUp)) If .Row < 2 Then Exit Sub 'No data ws.Range("A1", .Cells(.Cells.Count)).AdvancedFilter xlFilterCopy, , ws.Cells(1, ws.Columns.Count), True Set rngUnqAccts = Range(ws.Cells(2, ws.Columns.Count), ws.Cells(ws.Rows.Count, ws.Columns.Count).End(xlUp)) arrData = .Resize(, Columns("H").Column).Value ReDim arrResults(1 To rngUnqAccts.Cells.Count, 1 To UBound(arrData, 2)) End With For rIndex = LBound(arrData, 1) To UBound(arrData, 1) ResultIndex = WorksheetFunction.Match(arrData(rIndex, 1), rngUnqAccts, 0) If IsEmpty(arrResults(ResultIndex, 1)) Then arrResults(ResultIndex, 1) = arrData(rIndex, 1) arrResults(ResultIndex, 2) = arrData(rIndex, 2) End If For cIndex = 3 To UBound(arrData, 2) If Len(arrData(rIndex, cIndex)) > 0 Then arrResults(ResultIndex, cIndex) = arrData(rIndex, cIndex) Next cIndex Next rIndex rngUnqAccts.EntireColumn.Clear ws.Range("A2:A" & Rows.Count).Resize(, UBound(arrData, 2)).ClearContents ws.Range("A2").Resize(UBound(arrResults, 1), UBound(arrResults, 2)).Value = arrResults Set ws = Nothing Set rngUnqAccts = Nothing Erase arrData Erase arrResults End Sub