根據另一個單元格中的條件將正數值單元格輸入更改為同一單元格中的負數值

Question

我想通過引用另一個單元格范圍中的條件將一個范圍內的正值單元格輸入更改為負值。 因此，例如單元格范圍 A1:A10 包含值“B”或“S”。 單元格區域 B1:B10 是輸入數值的位置。 根據已在相應單元格 A1:A10 中輸入的數據，輸入這些值時將其設為正值或負值。 因此，在 B1 中輸入任何值（無論是正值還是負值）為 1234 或 -1234，其中 A1 的值為“B”將導致 B1 顯示 -1234。 相反，如果在單元格 B1:B10 中輸入任何正值或負值，並且 A 列中相應行的值為“S”，則 B 列中的值將始終為正值，無論原始輸入是負值還是正值。

如果 A1:A10 范圍內的特定單元格中沒有值對應於 B 列中的同一行，則應向用戶顯示一條消息，說“請在 A 列的相應行中輸入一個值。

我是 VBA 編碼的完全新手，到目前為止，我正在查看其他帖子已經拼湊了以下代碼，但我不知道如何完成它才能成功工作。

任何幫助將不勝感激。

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim A1 As Range
    Set A1 = Range("A1:A10")
    Dim A2 As Range
    Set A2 = Range("B1:B10")
    If Intersect(Target, A2) Is Nothing Then Exit Sub
    If IsText(Target, A1) Then
        If A1 = "S" Then
        Application.EnableEvents = False
            B1 = -B1
        Application.EnableEvents = True
    End If
End Sub

Answer 1

這應該是您需要的：

For循環允許您一次更改多個B列值。
如果 A 列的值既不是“B”也不是“S”，則不采取任何措施。

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim B As Range, Intersection As Range, cell As Range
    Dim v As String
    Set B = Range("B1:B10")
    Set Intersection = Intersect(Target, B)

    If Intersection Is Nothing Then Exit Sub

    Application.EnableEvents = False
        For Each cell In Intersection
            v = cell.Offset(0, -1).Value
            If v = "B" Then
                cell.Value = -Abs(cell.Value)
            ElseIf v = "S" Then
                cell.Value = Abs(cell.Value)
            End If
        Next cell
    Application.EnableEvents = True
End Sub

Answer 2

就地工作表更改

• 將整個代碼復制到工作表模塊（例如Sheet1 ）中。
• 代碼會自動執行所有操作，此處無需運行任何內容。
• function “獲取”從FirstRow中的單元格開始到最后一個非空單元格的列范圍。
• 該代碼會根據A列中的值自動修改B列中輸入的值。

編碼

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Const Proc As String = "Worksheet_Change"
    On Error GoTo cleanError

    Const FirstRow As Long = 1
    Dim Criteria As Variant: Criteria = Array("S", "B", "")
    Dim Cols As Variant: Cols = Array(1, 2) ' or Array("A", "B")

    Dim rngS As Range: Set rngS = getColumnRange(Me, Cols(1), FirstRow)
    If rngS Is Nothing Then Exit Sub
    Dim rngT As Range: Set rngT = Intersect(Target, rngS)
    If rngT Is Nothing Then Exit Sub
    Dim ColOffset As Long
    ColOffset = Columns(Cols(0)).Column - Columns(Cols(1)).Column

    Application.EnableEvents = False
    Dim cel As Range
    For Each cel In rngT.Cells
        Select Case cel.offset(, ColOffset).Value
            Case Criteria(0): cel.Value = Abs(cel.Value)
            Case Criteria(1): cel.Value = -Abs(cel.Value)
            Case Criteria(2): cel.Value = "Please enter a value into cell '" _
              & cel.offset(, ColOffset).Address(0, 0) & "'."
            Case Else ' Maybe the same as the previous!?
        End Select
    Next

CleanExit:
    Application.EnableEvents = True

Exit Sub

cleanError:
    MsgBox "An unexpected error occurred in '" & Proc & "'." & vbCr _
       & "Run-time error '" & Err.Number & "':" & vbCr _
       & Err.Description, vbCritical, Proc & " Error"
    On Error GoTo 0
    GoTo CleanExit

End Sub

Function getColumnRange(Sheet As Worksheet, _
                        ByVal AnyColumn As Variant, _
                        Optional ByVal FirstRow As Long = 1) _
         As Range
    Dim rng As Range
    Set rng = Sheet.Columns(AnyColumn).Find("*", , xlValues, , , xlPrevious)
    If rng Is Nothing Then Exit Function
    If rng.Row < FirstRow Then Exit Function
    Set getColumnRange = Sheet.Range(Sheet.Cells(FirstRow, AnyColumn), rng)
End Function