结果未计入 excel vba 电子表格

问题描述

（已编辑，问题已部分解决，请参阅评论）我是 VBA 新手，所以这可能很乏味，但是：我编写的代码存在一些问题，试图为发票添加折扣。我有它，如果在“组织列表”中的一个折扣列下的某一行中写入 1，则该折扣号将反映在“QuickCalcs”的成本列中，用于与具有折扣的组织相关联的项目。我已经对其进行了测试，以确保 if 语句正常工作，并且确实如此。计算也是正确的，但由于某些原因，这些值并没有取代通过乘以数量和费率计算出的原始成本。似乎 amount.value = amount.value - dis1 行和其他类似的行不起作用，或者我可能误解了它。当我测试时，我在另一个空单元格中出现了 amount.value 并显示了正确的值，但是由于某种原因将其输入到具有预先存在的数量的单元格中时它似乎不起作用，尽管这可能不是问题。你会建议我如何解决这个问题，以便正确的折扣金额反映在成本列（QuickCalcs，col L）中？我的代码如下。谢谢！！

Sub Discounts()
    Dim orgnameB    As Range
    Dim orgListB    As Range
    Set orgListB = Worksheets("Org List").Range("B3:B23")
    Dim siteTC      As Range
    Dim TCsites     As Range
    Set TCsites = Worksheets("TC Site Report").Range("B2:B23")
    Dim itemDescr   As Range
    Dim quickcalcsI As Range
    Set quickcalcsI = Worksheets("QuickCalcs").Range("I2:I23")
    
    ' Amount Calculation
    Dim amount      As Range
    Dim rateval     As Range
    Dim qtyval      As Range
    Dim total       As Double
    Dim dis1        As Integer
    Dim dis2        As Integer
    Dim dis3        As Integer
    Dim dis4        As Integer
    Dim dis5        As Integer
    Dim dis6        As Integer
    
    For Each orgnameB In orgListB
        If IsEmpty(orgnameB) = TRUE Then
            Exit For
        End If
        For Each siteTC In TCsites
            For Each itemDescr In quickcalcsI
                Set amount =     Worksheets("QuickCalcs").Cells(itemDescr.row,"L")
                Set rateval = Worksheets("QuickCalcs").Cells(itemDescr.row,"K")
                Set qtyval = Worksheets("QuickCalcs").Cells(itemDescr.row,"J")
                amount.Value = rateval.Value * qtyval.Value
                total = amount.Value
                
                If Worksheets("Org List").Cells(orgnameB.row,"I").Value = 1 Or Worksheets("Org List").Cells(orgnameB.row,"K").Value = 1 Or Worksheets("Org List").Cells(orgnameB.row,"J").Value = 1 Then
                    ' If discount : if orgnameB.row,colI,J,or K = 1,apply discount
                    
                    If itemDescr.Value = siteTC.Value Then
                        
                        'If current item in quickcalcs = item in TC Site Report
                        If Worksheets("TC Site Report").Cells(siteTC.row,"D") = orgnameB.Value And Worksheets("QuickCalcs").Cells(itemDescr.row,"H") <> "Annual Fee" Then
                            'If current item in quickcalcs is associated with that org
                            If Worksheets("Org List").Cells(orgnameB.row,"I") = 1 Then
                                percentoff1 = Worksheets("Org List").Cells(2,"I").Value / 100
                                dis1 = total * (percentoff1)
                                amount.Value = amount.Value - dis1
                            End If
                            If Worksheets("Org List").Cells(orgnameB.row,"J") = 1 Then
                                percentoff2 = Worksheets("Org List").Cells(2,"I").Value / 100
                                dis2 = total * (percentoff2)
                                amount.Value = amount.Value - dis2
                            End If
                            If Worksheets("Org List").Cells(orgnameB.row,"K") = 1 Then
                                percentoff3 = Worksheets("Org List").Cells(2,"I").Value / 100
                                dis3 = total * (percentoff3)
                                amount.Value = amount.Value - dis3
                            End If
                        End If
                    End If
                End If
            Next
        Next
    Next
    
End Sub

Ranges Worked with,QuickCalcs Tab

Ranges Worked with,TC Site Report Tab

Ranges Worked with,Org List

解决方法

尝试重新安排循环的嵌套，以便只扫描一次 Worksheets("QuickCalcs")。 percentoff 是否总是 wsOrg.Cells(2,"I").Value 即使例如 wsOrg.Cells(r2,"J") = 1 ？

Option Explicit

Sub Discounts()

    Dim wsOrg As Worksheet,orgnameB As Range,orgListB As Range
    Set wsOrg = Worksheets("Org List")
    Set orgListB = wsOrg.Range("B3:B23")

    Dim wsSite As Worksheet,siteTC As Range,TCsites As Range
    Set wsSite = Worksheets("TC Site Report")
    Set TCsites = wsSite.Range("B2:B23")

    Dim wsCalc As Worksheet,itemDescr As Range,quickcalcsI As Range
    Set wsCalc = Worksheets("QuickCalcs")
    Set quickcalcsI = wsCalc.Range("I2:I23")

    ' Amount Calculation
    Dim amount As Range,rateval As Range,qtyval As Range
    Dim total,percentoff,dis
    Dim r1 As Long,r2 As Long,r3 As Long

    For Each itemDescr In quickcalcsI
        r1 = itemDescr.Row

        With Worksheets("QuickCalcs")
            Set amount = .Cells(r1,"L")
            Set rateval = .Cells(r1,"K")
            Set qtyval = .Cells(r1,"J")
            amount.Value = rateval.Value * qtyval.Value
            total = amount.Value
        End With

        For Each orgnameB In orgListB
            If IsEmpty(orgnameB) = True Then
                Exit For
            End If
            r2 = orgnameB.Row

            ' If discount : if orgnameB.row,colI,J,or K = 1,apply discount
            If wsOrg.Cells(r2,"I").Value = 1 _
                Or wsOrg.Cells(r2,"K").Value = 1 _
                Or wsOrg.Cells(r2,"J").Value = 1 Then

                For Each siteTC In TCsites
                     
                    If itemDescr.Value = siteTC.Value Then
                        r3 = siteTC.Row
                            'If current item in quickcalcs = item in TC Site Report
                        If wsSite.Cells(r3,"D") = orgnameB.Value _
                           And wsCalc.Cells(r1,"H") <> "Annual Fee" Then

                            'If current item in quickcalcs is associated with that org
                            If wsOrg.Cells(r2,"I") = 1 Then
                                percentoff = wsOrg.Cells(2,"I").Value / 100
                                dis = total * percentoff
                                amount.Value = amount.Value - dis
                            End If
                            If wsOrg.Cells(r2,"J") = 1 Then
                                percentoff = wsOrg.Cells(2,"K") = 1 Then
                                percentoff = wsOrg.Cells(2,"I").Value / 100
                                dis = total * percentoff
                                amount.Value = amount.Value - dis
                            End If
                        End If
                    End If

                Next
            End If
        Next
    Next
    MsgBox "Done"
End Sub

,

使用三重嵌套循环并不是真正的可扩展解决方案，并且很难通过单步调试 (F8)。更好的方法是使用 Find 直接定位其他工作表上的匹配行。例如

Sub Discount2()

    Dim iLastRow As Long
    Dim wsOrg As Worksheet,orgListB As Range
    Set wsOrg = Worksheets("Org List")
    iLastRow = wsOrg.Cells(Rows.Count,"B").End(xlUp).Row
    Set orgListB = wsOrg.Range("B3:B" & iLastRow)

    Dim wsSite As Worksheet,TCsites As Range
    Set wsSite = Worksheets("TC Site Report")
    iLastRow = wsSite.Cells(Rows.Count,"B").End(xlUp).Row
    Set TCsites = wsSite.Range("B2:B" & iLastRow)

    Dim wsCalc As Worksheet,quickcalcsI As Range
    Set wsCalc = Worksheets("QuickCalcs")
    iLastRow = wsCalc.Cells(Rows.Count,"I").End(xlUp).Row
    Set quickcalcsI = wsCalc.Range("I2:I" & iLastRow)

    Dim amount As Range,qtyval As Range
    Dim rng As Range,org As String,dis As Single
    Dim r As Long,n As Long

    ' scan down sheet
    For Each itemDescr In quickcalcsI

        Set amount = Worksheets("QuickCalcs").Cells(itemDescr.Row,"L")
        Set rateval = Worksheets("QuickCalcs").Cells(itemDescr.Row,"K")
        Set qtyval = Worksheets("QuickCalcs").Cells(itemDescr.Row,"J")
        amount.Value = rateval.Value * qtyval.Value
        dis = 0

        ' find org for site
        Set rng = TCsites.Find(itemDescr,LookIn:=xlValues,LookAt:=xlWhole)
        If rng Is Nothing Then
            MsgBox "Site '" & itemDescr & "' not found",vbExclamation,"Row " & itemDescr.Row
        Else
            org = rng.Offset(,2) ' col d
            ' Find discount for org
            Set rng = orgListB.Find(org,LookAt:=xlWhole)
            If rng Is Nothing Then
                MsgBox "Org '" & org & "' not found","Row " & itemDescr.Row
            Else
                r = rng.Row
                If wsOrg.Cells(r,"I") = 1 Then
                    dis = wsOrg.Cells(2,"I")
                ElseIf wsOrg.Cells(r,"J") = 1 Then
                    dis = wsOrg.Cells(2,"J")
                ElseIf wsOrg.Cells(r,"K") = 1 Then
                    dis = wsOrg.Cells(2,"K")
                End If
            End If
        End If

        ' apply discount
        If dis > 0 Then
            amount.Value = amount.Value * (100 - dis) / 100
            'amount.Interior.Color = vbYellow ' use to debug
            n = n + 1
        Else
            'amount.Interior.Color = vbWhite ' use to debug
        End If
    Next
    MsgBox n & " rows  discounted",vbInformation
   
End Sub