VBA代码:分解值直到它达到零
VBA代码:分解值直到它达到零
提问于 2021-03-23 19:13:28
我一直试图在VBA中运行具有以下逻辑方案的代码：
- 如果"MVT库存“(由C列表示)< "Tot库存”(以D列表示)，则在位于"Tot库存“列本身的单元格上显示差异(”then“-- "MVT库存”)；
- If ("MVT库存“> "Tot库存”)，然后在B栏中找到下一个带有相同字母的"Tot库存“，并减去剩余的差额"MVT库存”-- "Tot库存“，直到这一差异达到零为止。
示例：
A- "MVT库存“= 500，"Tot库存”= 1200，然后"Tot库存“= 1200 - 500 = 700。
另一个A- "MVT库存“= 1500和"Tot库存”= 400，"Tot库存“=- 1100。
-1100的差需要在Name列中找到另一行的A，然后用另一个"Tot库存“减去，直到差值达到零为止。除此之外，MVT列中的所有单元格都需要在程序结束时达到零。
这是我工作的工作表：
这是我做过的代码。在第一个Else条件下的If命令之后，我遇到了问题。在那之前代码运行正常。
Dim i, j, k As Integer
Dim dif
last_main_row = Sheets("Inventories").Range("B" & Rows.count).End(xlUp).Row
last_name_row = Sheets("Inventories").Range("H" & Rows.count).End(xlUp).Row
For j = 5 To last_name_row
While Cells(j, "I") <> 0
For i = 4 To last_main_row
dif = Cells(i, "D") - Cells(i, "C")
If dif >= 0 Then
Cells(i, "D") = dif
Cells(i, "C") = 0
Else
While dif < 0
For k = 4 To last_main_row
If Cells(j, "B") = Cells(k, "B") Then
Cells(k, "D") = Cells(k, "D") + dif
dif = dif + Cells(k, "D")
End If
Next
Wend
End If
Next
Wend
Next回答 2
Stack Overflow用户
发布于 2021-03-23 20:57:54
' Try this instead
Sub testnja()
Dim NameRow As Range
Dim NameInvRow As Range
Dim NameInvRowFind As Range
For Each NameRow In ActiveSheet.UsedRange.Columns(8).Cells
NameRow.Select
If NameRow.Row > 1 Then
If Trim(NameRow) <> "" Then
For Each NameInvRow In ActiveSheet.UsedRange.Columns(2).Cells
If NameInvRow = NameRow Then
If NameInvRow.Offset(0, 2) >= NameInvRow.Offset(0, 1) Then
NameInvRow.Offset(0, 2) = NameInvRow.Offset(0, 2) - NameInvRow.Offset(0, 1)
NameInvRow.Offset(0, 1) = 0
Else
For Each NameInvRowFind In ActiveSheet.UsedRange.Columns(2).Cells
If NameInvRowFind = NameRow And _
NameInvRowFind.Row <> NameInvRow.Row Then
If NameInvRowFind.Offset(0, 2) >= NameInvRow.Offset(0, 1) Then
NameInvRowFind.Offset(0, 2) = NameInvRowFind.Offset(0, 2) - NameInvRow.Offset(0, 1)
NameInvRow.Offset(0, 1) = 0
Exit For
End If
End If
Next
End If
End If
Next
Else
Exit Sub
End If
End If
Next
End SubStack Overflow用户
发布于 2021-03-23 21:22:52
如果将diff添加到MVT列，而不是从Tot中减去，那么如果Tot小于差值，则避免递归。
Option Explicit
Sub a()
Dim i As Long, j As Long, k As Long
Dim dif As Long, sName As String
Dim last_main_row As Long, last_name_row As Long
With Sheets("Inventories")
last_main_row = .Range("B" & Rows.Count).End(xlUp).Row
last_name_row = .Range("H" & Rows.Count).End(xlUp).Row
End With
For i = 2 To last_main_row
dif = Cells(i, "D") - Cells(i, "C")
sName = Cells(i, "B")
If dif >= 0 Then
Cells(i, "C") = 0
Cells(i, "D") = dif
Else
' add diff onto next occurance of name
For k = i + 1 To last_main_row
If Cells(k, "B") = sName Then
Cells(k, "C") = Cells(k, "C") - dif
Cells(i, "C") = 0
Cells(i, "D") = 0
dif = 0
Exit For
End If
Next
If dif <> 0 Then
MsgBox "No record " & sName & " for diff of " & dif, vbExclamation
End If
End If
Next
End Sub页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/66769831
复制相关文章
相似问题
腾讯云开发者
Copyright © 2013 - 2026 Tencent Cloud. All Rights Reserved. 腾讯云 版权所有
深圳市腾讯计算机系统有限公司 ICP备案/许可证号：粤B2-20090059 
粤公网安备44030502008569号
腾讯云计算（北京）有限责任公司 京ICP证150476号 | 京ICP备11018762号