Excel 如何根据VBA中的值有条件地减去数字 Table1:Table3: 余额|转移余额 20000是的 30000部分 40000部分 五万对 表2： 余额转移 一万对 20000部分 三万对 21000部分

我有两个包含余额金额的表和一个带有下拉列表的列（是、否、部分）。我需要减去表1和表2中被选为部分的所有内容

所以在下面的例子中，我需要从表1中减去30000，从表2中减去20000。另一部分的平衡也是如此。每种情况都会有所不同，因此我可能会在不同的单元格中有4或5个部分（每个表中的部分数量始终相同）。我一直在写一个VBA代码，我可以说表1中所有表示partial的内容都将减去表2中标记为partial的内容，然后将剩余金额移到表3中。这只是我整个宏的一个小过程，所以我需要在VBA中使用它。我的理想输出应该是：

表3：
平衡
10000-第1部分
19000-第2部分

当前代码如下所示：

If Sheets ("1").Cells(1,10).Value = "Yes" Then 'Rows that are marked as yes
Sheets('1").Cells(1,4).Copy 'This will copy data from that specific row
Sheets("2").Range("A28").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats 'Paste value in other sheet and table

ElseIf Sheets("1").Cells(i, 10).Value = "Partial" And Sheets("1").Cells(i, 10).Value = "Partial" Then 
'Here is where I need to specify to grab the balance from Table1 and subtract it to value in Table2 that says Partial and paste the result in Sheets("2")

---

您需要比较表1中的第一个“部分”与表2中的第二个“部分”，等等。从技术上讲，您可以在没有VBA的情况下使用

索引

和

过滤器

（Office365）或

聚合

（Office的早期版本）：（为了简单起见，我将

表1

和

表2

视为命名范围）

（在运行比较时，如果“Partial”有前导空格或尾随空格，则可能需要包含

修剪

）

这意味着您可以使用VBA应用公式，然后仅将其展平到值。这里，为了简单起见，我将把

Table1

、

Table2

和

Table3

作为子对象的

Range

参数（包括标题）

Sub PartialTableDifferences(Table1 AS Range, Table2 AS Range, Table3 As Range)
    Dim Partials_Table1 AS Long, Partials_Table2 AS Long, RangeToFill AS Range

    Partials_Table1 = WorksheetFunction.CountIf(Table1.Columns(2),"Partial")
    Partials_Table2 = WorksheetFunction.CountIf(Table2.Columns(2),"Partial")

    If Partials_Table1 + Partials_Table2 < 1 Then Exit Sub 'No Partials to compare

    'Set the correct size for Table 3
    If Partials_Table1 > Partials_Table2 Then
        Set RangeToFill = Table3.Offset(1,0).Resize(Partials_Table1,1)
    Else
        Set RangeToFill = Table3.Offset(1,0).Resize(Partials_Table2,1)
    End If

    With RangeToFill
        'Office365
        '.Formula = "=IFERROR(INDEX(FILTER(" & Table1.Columns(1).Address(True, True, xlA1, True) & ", TRIM(" & Table1.Columns(2).Address(True, True, xlA1, True) & ")=""Partial""), Row()-" & Table3.Cells(1,1).Row & "), 0) " & _
            "- IFERROR(INDEX(FILTER(" & Table2.Columns(1).Address(True, True, xlA1, True) & ", TRIM(" & Table2.Columns(2).Address(True, True, xlA1, True) & ")=""Partial""), Row()-" & Table3.Cells(1,1).Row & "), 0)"

        'Older Versions
        .Formula = "=IFERROR(INDEX(" & Table1.Columns(1).Address(True, True, xlA1, True) & ", AGGREGATE(15, 6, Row(" & Table1.Columns(2).Address(True, True, xlA1, True) & ")/(TRIM(" & Table1.Columns(2).Address(True, True, xlA1, True) & ")=""Partial""), Row()-" & Table3.Cells(1,1).Row & ")), 0) " & _
            "- IFERROR(INDEX(" & Table2.Columns(1).Address(True, True, xlA1, True) & ", AGGREGATE(15, 6, Row(" & Table2.Columns(2).Address(True, True, xlA1, True) & ")/(TRIM(" & Table2.Columns(2).Address(True, True, xlA1, True) & ")=""Partial""), Row()-" & Table3.Cells(1,1).Row & ")), 0)"

        .Calculate
        .Value = .Value
    End With
End Sub

Sub-PartialTableDifferences（表1作为范围，表2作为范围，表3作为范围）
表1为长，表2为长，范围为长
Partials_Table1=工作表函数.CountIf（表1.列（2），“部分”）
Partials_Table2=工作表函数.CountIf（表2.列（2），“部分”）
如果Partials_Table1+Partials_Table2<1，则退出Sub“无需比较的Partials”
'为表3设置正确的大小
如果Partials_Table1>Partials_Table2，则
设置RangeToFill=Table3.偏移量（1,0）.调整大小（部分\u Table1,1）
其他的
设置RangeToFill=Table3.偏移量（1,0）.调整大小（部分\表2,1）
如果结束
与兰格托菲尔
“办公室365
“.Formula=“=IFERROR（索引（过滤器（&Table1.Columns（1）.地址（True，True，xlA1，True））和“&Table1.Columns（2）.地址（True，True，xlA1，True）&”）=”部分“”，行（）-“&Table3.Cells（1,1）.行和“，”0）&”_
“-IFERROR（索引（筛选器（“&Table2.Columns（1）.地址（True，True，xlA1，True））和“&Table2.Columns（2）.地址（True，True，xlA1，True）&”）=”部分“”），行（）-“&Table3.Cells（1,1）.行（”，0）”
“旧版本
.Formula=“=IFERROR（INDEX（&&Table1.Columns（1）.Address（True，True，xlA1，True）和）”，聚合（15，6，行（&&Table1.Columns（2）.Address（True，True，xlA1，True））和/（TRIM（&&Table1.Columns（2）.Address（True，True，xlA1，True）和“=”部分“），行（）-”和表3.Cells（1，1.Row&）”，0和_
“-IFERROR（索引（&&Table2.Columns（1）.地址（True，True，xlA1，True）和）”，聚合（15，6，行（&&Table2.Columns（2）.地址（True，True，xlA1，True）和）/（TRIM（&&Table2.Columns（2）.地址（True，True，xlA1，True）和“=”）=”，行（）-“&Table3.Cells（1，1）.行和“），0）”
.算计
.Value=.Value
以
端接头

到目前为止，您尝试了什么？这需要基于行还是完整条目？（例如，表3中29000有一条记录，还是10000和19000有两条记录？）您是否熟悉

索引

、

过滤器、

SUMIF`和/或

聚合

函数？似乎您可以很快地用公式完成此操作-不需要VBA。hel pto还会在表中显示预期输出吗34@TimWilliams这只是我目前拥有的整个vba的一小部分。所以我需要添加这个端口。这只是一个例子，但可能有10行、不同数字等的百万个案例，所以基本上我需要触发它，其中显示“部分”，然后减去这2个余额，并在另一个表中显示结果。@计时表3将有2条记录，10000和19000在不同的行中。我熟悉这些函数，但不知道如何指定：如果表1-第2行-部分和表2-第3行-部分，则获取两者的余额，减去，并在表3中显示结果。

Sub PartialTableDifferences(Table1 AS Range, Table2 AS Range, Table3 As Range)
    Dim Partials_Table1 AS Long, Partials_Table2 AS Long, RangeToFill AS Range

    Partials_Table1 = WorksheetFunction.CountIf(Table1.Columns(2),"Partial")
    Partials_Table2 = WorksheetFunction.CountIf(Table2.Columns(2),"Partial")

    If Partials_Table1 + Partials_Table2 < 1 Then Exit Sub 'No Partials to compare

    'Set the correct size for Table 3
    If Partials_Table1 > Partials_Table2 Then
        Set RangeToFill = Table3.Offset(1,0).Resize(Partials_Table1,1)
    Else
        Set RangeToFill = Table3.Offset(1,0).Resize(Partials_Table2,1)
    End If

    With RangeToFill
        'Office365
        '.Formula = "=IFERROR(INDEX(FILTER(" & Table1.Columns(1).Address(True, True, xlA1, True) & ", TRIM(" & Table1.Columns(2).Address(True, True, xlA1, True) & ")=""Partial""), Row()-" & Table3.Cells(1,1).Row & "), 0) " & _
            "- IFERROR(INDEX(FILTER(" & Table2.Columns(1).Address(True, True, xlA1, True) & ", TRIM(" & Table2.Columns(2).Address(True, True, xlA1, True) & ")=""Partial""), Row()-" & Table3.Cells(1,1).Row & "), 0)"

        'Older Versions
        .Formula = "=IFERROR(INDEX(" & Table1.Columns(1).Address(True, True, xlA1, True) & ", AGGREGATE(15, 6, Row(" & Table1.Columns(2).Address(True, True, xlA1, True) & ")/(TRIM(" & Table1.Columns(2).Address(True, True, xlA1, True) & ")=""Partial""), Row()-" & Table3.Cells(1,1).Row & ")), 0) " & _
            "- IFERROR(INDEX(" & Table2.Columns(1).Address(True, True, xlA1, True) & ", AGGREGATE(15, 6, Row(" & Table2.Columns(2).Address(True, True, xlA1, True) & ")/(TRIM(" & Table2.Columns(2).Address(True, True, xlA1, True) & ")=""Partial""), Row()-" & Table3.Cells(1,1).Row & ")), 0)"

        .Calculate
        .Value = .Value
    End With
End Sub

Sub Procedure1()

'1.declare variables
'2.clear old search results
'3.find records that match criteria and paste them

Dim transfer As String
Dim i As Integer 'row counter


Sheets("2").Range("A12:D28").ClearContents 'Where I want to transfer the data


For i = 12 To 28

If Sheets("1").Cells(i, 10).Value = "Yes" Then 'Where current data is located

Sheets("1").Cells(i, 4).Copy 'Additional data I want to move

Sheets("2").Range("A28").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats

Sheets("1").Cells(i, 9).Copy 'Additional data I want to move

Sheets("2").Range("B28").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats

Sheets("1").Cells(i, 1).Copy 'Additional data I want to move

Sheets("2").Range("C28").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats

Sheets("FSR Analysis").Cells(i, 5).Copy 'This is the balance

Sheets("Transfer Form").Range("D28").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats

'This code is fine, I need help with the one below'

End If
        
Next i


End Sub

Sub Procedure2()

Dim i As Integer 'row counter

For i = 12 To 28

If Sheets("1").Cells(i, 10).Value = "Partial" Then

Sheets("1").Cells(i, 4).Copy 'Additional data I want to move

Sheets("2").Range("A28").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats

Sheets("1").Cells(i, 9).Copy 'Additional data I want to move

Sheets("2").Range("B28").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats

Sheets("1").Cells(i, 1).Copy 'Additional data I want to move

Sheets("2").Range("C28").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats

Sheets("1").Cells(i, 5).Copy 'This is the balance column from Table1 that I am trying to subtract. I need first to specify the tables as ranges (not sure how) and then specify that for those wthat says PArtial in table1 and table2 subtract and move to sheets"2"

Sheets("2").Range("D28").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats


End If
        
Next i


End Sub