如何解决结果未计入 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
解决方法
尝试重新安排循环的嵌套，以便只扫描一次 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
版权声明：本文内容由互联网用户自发贡献，该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容， 请发送邮件至 dio@foxmail.com 举报，一经查实，本站将立刻删除。
