我想要做的是如果创建的每个小计中的值为 1,则进行 SUM 。我尝试过使用小计选项,但无法使其工作(可能是因为我不擅长使用 Excel),有时我会在总和中得到 0 和 1。所以我决定制作一个VBA。
这组数据差不多了
- | A | B | C |
-----------------------------
1 | Names | Points | N |
-----------------------------
2 | Grimer | 1 | 88 |
3 | Grimer | 1 | 88 |
4 | Grimer | 0 | 88 |
5 | Psyduck | 1 | 54 |
6 | Psyduck | 0 | 54 |
7 | Psyduck | 0 | 54 |
8 | Pikachu | 1 | 25 |
9 | Pikachu | 1 | 25 |
10| Pikachu | 1 | 25 |
这就是我想要得到的:
| A | B | C |
-------------------------------
1 | Names | Points | N |
-------------------------------
| 2 | Grimer | 1 | 88 |
| 3 | Grimer | 1 | 88 |
| 4 | Grimer | 0 | 88 |
- 5 | Grimer | 2 | 88 |
| 6 | Psyduck | 1 | 54 |
| 7 | Psyduck | 0 | 54 |
| 8 | Psyduck | 0 | 54 |
- 9 | Psyduck | 1 | 54 |
| 10| Pikachu | 1 | 25 |
| 11| Pikachu | 1 | 25 |
| 12| Pikachu | 1 | 25 |
- 13| Pikachu | 3 | 25 |
每行开头的虚线(从2开始)是我想要创建的组(每行的B单元格是结果......它应该是粗体)。下面的代码是获取之前的结果(表)。它有效,但我想知道是否有更好的解决方案在 Excel 上执行而无需编程。或者...是否有任何错误,因为当我运行它时,需要几秒钟(对于超过 4000 行)。
Sub GetPointsByPokemon()
With ThisWorkbook.ActiveSheet
Dim Fila As Integer, InitRow As Integer, Suma As Integer
PkNumber = .Range("C2").Value
InitRow = 2
ActualRow = 2
Suma = 0
Do Until .Cells(ActualRow, 1).Value = ""
If .Cells(ActualRow, 2).Value = 1 Then
Suma = Suma + 1
End If
If PkNumber <> .Range("C" & (ActualRow + 1)).Value Then
.Cells(ActualRow, 1).Offset(1).EntireRow.Insert
PkNumber = .Range("C" & (ActualRow + 2)).Value
.Range(ActualRow & ":" & ActualRow).Offset(1).Value = .Range(ActualRow & ":" & ActualRow, 1).Value
.Range("B" & (ActualRow + 1)).Value = Suma
.Rows(InitRow & ":" & ActualRow).Group
ActualRow = ActualRow + 1
InitRow = ActualRow + 1
Suma = 0
End If
ActualRow = ActualRow + 1
Loop
End With
End Sub
所有数据都是示例,我必须更改代码上的一些值。我已经使用 MySQL 完成了它,但我真的想知道如何在 excel(和 vba)上完成它,提前致谢!
最佳答案
就我个人而言,我喜欢妙蛙种子。
我也不喜欢这种方法,因为您将小计硬编码到工作表上并将它们编织到源数据中。
但是如果您仍然想这样做,这里是代码。虽然很丑,但是很管用。
Sub AddSubtotals()
Dim i As Long
Dim numberOfRows As Long
' number of pokemon
numberOfRows = Cells(Rows.Count, "A").End(xlUp).Row
' do bottom row first
Cells(numberOfRows + 1, 1).value = Cells(numberOfRows, 1).value
Cells(numberOfRows + 1, 2).FormulaR1C1 = "=SUMIF(R[-" & numberOfRows - 1 & "]C[-1]:R[-" & numberOfRows - (numberOfRows - 1) & "]C[-1],""" & Cells(numberOfRows, 1).value & """,R[-" & numberOfRows - 1 & "]C[0]:R[-" & numberOfRows - (numberOfRows - 1) & "]C[0])"
' convert to value
Cells(numberOfRows + 1, 2).value = Cells(numberOfRows + 1, 2).value
Cells(numberOfRows + 1, 3).value = Cells(numberOfRows, 3).value
Range(Cells(numberOfRows + 1, 1), Cells(numberOfRows + 1, 3)).Font.Bold = True
' insert blank row in between each group of pokemon
' loop backwards because we are inserting rows
For i = numberOfRows To 3 Step -1
If Cells(i, 1).value <> Cells(i - 1, 1).value Then
Cells(i, 1).EntireRow.Insert xlShiftDown
' copy pokemon name down
Cells(i, 1).value = Cells(i - 1, 1).value
' put formula into Points field
Cells(i, 2).FormulaR1C1 = "=SUMIF(R[-" & i - 1 & "]C[-1]:R[-" & i - (i - 1) & "]C[-1],""" & Cells(i, 1).value & """,R[-" & i - 1 & "]C[0]:R[-" & i - (i - 1) & "]C[0])"
' convert to value
Cells(i, 2).value = Cells(i, 2).value
' copy N value down
Cells(i, 3).value = Cells(i - 1, 3).value
Range(Cells(i, 1), Cells(i, 3)).Font.Bold = True
End If
Next i
End Sub
代码之前的示例数据:
代码后的示例数据:
关于vba - 在多列中显示小计,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/11556808/