根据特定条件 (vba) 对 excel sheet 进行排序

Question

这是我的问题，我的 Sheet1 上有这些数据

       A      B        C
   1 Name   Account  Amount 
   2 John   HSBC     -20000
   3 Ashley JPM      140000
   4 Rose   BAML     70000
   5 John   DB       10000
   6 Rose   Barclays -25000
   7 Ashley JPM      -3000

我的目标是使用 vba 对行进行排序并按名称和数量对它们进行分组。我在 Sheet2 中寻找的结果是：

       A      B        C
   1 Name   Account  Amount 
   2 John   HSBC     -20000
   3 John   DB       10000
   4
   5 Ashley JPM      -3000
   6 Ashley JPM      140000
   7
   8 Rose   Barclays -25000
   9 Rose   BAML     70000

我已经先取负值成功了，剩下的还是难取，组间空行

这是我开始的代码：

Option Explicit

Sub sort_account()

Dim list_amount As Range, amount As Range
Dim b As Integer

Worksheets("Sheet1").Activate
Set list_amount = Worksheets("Sheet1").Range("C2", Range("C2").End(xlDown))

For Each amount In list_amount
    If amount.Value < 0 Then
        
        b = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
        Worksheets("Sheet2").Cells(b + 1, 1).Value = amount.Offset(0, -2)
        Worksheets("Sheet2").Cells(b + 1, 2).Value = amount.Offset(0, -1)
        Worksheets("Sheet2").Cells(b + 1, 3).Value = amount
        
    End If
Next amount

Worksheets("Sheet2").Activate

End Sub

结果是：

       A      B        C
   1 Name   Account  Amount 
   2 John   HSBC     -20000
   5 Ashley JPM      -3000
   8 Rose   Barclays -25000

剩下的真有难处。你有什么想法？在此先感谢您。

Nb : 顺序无关紧要，我只希望每组的第一个值是负数。

谢谢！

Answer 1

如果您的 Excel 版本支持动态数组，那么您可以执行以下操作

此解决方案为每个唯一名称添加一个额外的行，对新数据进行排序，然后清空添加的行。

E2 是 =CHOOSE({1,2,3},UNIQUE(A2:A7),"temp",99999999)。这将创建一个数组，其中第一列中包含所有唯一名称，第二列中包含“temp”，第三列中包含 99999999（用于排序）。

F6 是 =ROWS(A2:C7) 数据中的行数 F7 是 =ROWS(E2#) 唯一名称的计数

A10 是 =IF(SEQUENCE(F6+F7)<=F6,A2:C7,INDEX(E2#,SEQUENCE(F6+F7)-F6,SEQUENCE(1,3)))。这会将原始数据附加到新数据。

E10为=SORT(A10#,{1,3})，追加数据已排序

I10 是 =IF(F10:F18="temp","",E10#)。这会清空所有临时工行。

如果您的 Excel 版本支持 LET，您可以在一个单元格中执行此操作。

=LET(data,A2:C7,
     tempRows,CHOOSE({1,2,3},UNIQUE(A2:A7),"temp",99999999),
     totalRows,ROWS(data),
     uniqueNames,ROWS(tempRows),
     outRows, SEQUENCE(totalRows+uniqueNames),
     unsorted,IF(outRows<=totalRows,data,INDEX(tempRows,outRows-totalRows,{1,2,3})),
     sorted,SORT(unsorted,{1,3}),
     result, IF(INDEX(sorted,outRows,2)="temp","",INDEX(sorted,outRows,{1,2,3})),
 result)

Answer 2

如果这是我的项目，我会分三个不同的步骤进行：将所有数据从 sheet 1 复制到 sheet 2；按首选顺序对数据进行排序；从底部开始插入空白行。以下代码应该可以满足您的需求。

Option Explicit
Sub sort_account()
Dim LastRow As Long, i As Long

Sheet2.Cells.ClearContents
Sheet1.UsedRange.Copy Sheet2.Range("A1")

Sheet2.Columns("A:C").Sort Key1:=Sheet2.Range("A2"), order1:=xlAscending, _
Key2:=Sheet2.Range("C2"), order2:=xlAscending, Header:=xlYes

LastRow = Sheet2.Cells(Rows.Count, "A").End(xlUp).Row
For i = LastRow To 4 Step -1
    If Sheet2.Cells(i, "A") = Sheet2.Cells(i - 1, 1) Then
        Sheet2.Cells(i - 1, "A").EntireRow.Insert
    End If
Next i

End Sub

根据特定条件 (vba) 对 excel sheet 进行排序

Sort an excel sheet with specific conditions (vba)

sorting

excel

grouping

vba

loops