Question

我正试图从这里得到一张excel表:(抱歉，我的声誉不够高，无法发布图片，所以我自己托管了它们。）

到

我找到并修改了一些VBA代码：

管理这些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

行似乎导致负数被删除，因为它们不比它们上面的空白单元格大。（对吗？）我找不到A）不删除负数的解决方案，B）不需要一个小时才能运行。

我尝试用以下内容交换该行：

If Len(Trim(oCell)) = 0 Then

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

还有其他方法我们可以排序然后组合行而不会丢失负片或花一小时运行？

我确信有一个简单的解决方案..但我是VBA代码的新手。

谢谢，

Answer 1

此代码不要求对数据进行排序，并且它将正确保留负数。它应该运行得相当快：

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

VBA代码 - 将excel行与负数组合

1 个答案: