如何从一张纸上的单元格中找到相应的名称/值,并从另一张纸上的相应单元格中减去它的数字

问题描述 投票:0回答:1

我需要找到一个零件对应的名称,并减去它在另一张纸上的编号,如果有数字要减去(数字大于0)。

我需要将其分散到每个零件的总和中,目前位于第 61 行,但如果需要,我稍后会更改它。
这需要点击一个按钮。我知道如何在按钮下分配VBA。

  • 如果C30>0
  • 从工作表 PortBoardVariations 单元格 C60 中查找与工作表 PartsWarehouse 范围 A:A 中的单元格中的文本相匹配的文本
  • 从工作表 PartsWarehouse 对应的行 F 列中减去 PortBoardVariations 单元格 C61 的值
  • 否则对该单元格不执行任何操作

-- 对范围表 PortBoardVariations 中单元格 C60:EM60 中的每个单元格执行此操作。

-- 比较 >0 个单元格,即对于 C60,它是 C61,对于 D60,它是 D61,依此类推。

-- 将来有可能将更多组件添加到 PortBoardVariations 和 PartsWarehouse 中,或者仅添加到 PartsWarehouse 中。

示例 xlsm:Warehouse.xlsm

如何将我的代码传播到整个范围 C60:EM60?

Sub FindAndSubstract_PortBoard()
Dim t
Dim answer As Integer

answer = MsgBox("Substract parts from warehouse?", vbQuestion + vbYesNo + vbDefaultButton2, "Message Box Title")
If answer = vbYes Then
If Worksheets("PortBoardVariations").Cells(57, 4).Value <> "" Then 'Test if this parts cell is empty

'this needs to be spreaded for every cell in range C60:EM60, not only Cells(1, 4)
t = Application.Match(Worksheets("PortBoardVariations").Cells(1, 4).Value, Worksheets("PartsWarehouse").Range("A:A"), 0) 'Match same text on sesond sheet

'this also needs to be spreaded for every cell in range F:F, not only "Cells(3, 6)" and range C60:EM60, not only Cells(61, 4)
If Not IsError(t) Then 'if anything is matched, go on
    Worksheets("PartsWarehouse").Cells(3, 6).Value = Worksheets("PartsWarehouse").Range("F" & t) - Worksheets("PortBoardVariations").Cells(61, 4).Value
    MsgBox "Parts were substracted from warehouse" 'notify user operation has been done
Else 'if anything is not matched, show message to user
    MsgBox "Nothing found"
End If
Else
MsgBox "Nothing to substract" 'if anything is matched but no parts needed for this, show message to user
End If
Else
MsgBox "Operation cancelled by user"
End If
End Sub
excel vba if-statement find match
1个回答
0
投票
    由于样本数据存在大量不匹配,
  • parts were not found
    通知目前已被禁用。您可以通过删除代码中的注释来启用它们。
Option Explicit

Sub FindAndSubstract_PortBoard()
    Dim answer As Long, iMch, iVal
    Dim c As Range, i As Long, lastCol As Long
    Dim luSht As Worksheet
    Const SUM_ROW = 60  ' row num on PortBoardVariations
    Const LU_SHT = "PartsWarehouse" ' Lookup sheet
    Const LU_COL = 1    ' Looup column
    Const LU_VAL = "F"  ' Value column
    answer = MsgBox("Substract parts from warehouse?", vbQuestion + vbYesNo + vbDefaultButton2, "Message Box Title")
    If answer = vbYes Then
        iVal = -1
        Set luSht = Sheets(LU_SHT)
        With Worksheets("PortBoardVariations")
            ' look through each column
            lastCol = .Cells(SUM_ROW, .Columns.Count).End(xlToLeft).Column
            For i = 2 To lastCol
                iVal = .Cells(SUM_ROW + 1, i)
                If Len(.Cells(SUM_ROW, i)) > 0 And IsNumeric(iVal) And iVal > 0 Then
                    ' search pats
                    iMch = Application.WorksheetFunction.Match(.Cells(SUM_ROW, i), luSht.Columns(LU_COL), 0)
                    If IsError(iMch) Then
                        ' MsgBox "Parts [" & .Cells(SUM_ROW, i) & "] were not found"
                    Else
                        ' Update qty
                        With luSht.Cells(iMch, LU_VAL)
                            .Value = .Value - iVal
                        End With
                        MsgBox "Parts [" & .Cells(SUM_ROW, i) & "] were substracted from warehouse"
                    End If
                End If
            Next
        End With
        If iVal = -1 Then
            MsgBox "Nothing found"
        End If
    Else
        MsgBox "Operation cancelled by user"
    End If
End Sub
© www.soinside.com 2019 - 2024. All rights reserved.