我想通过参考另一个像元范围中的标准将一个范围中的正值像元输入更改为负值。因此,例如,单元格区域A1:A10包含值“ B”或“ S”。单元格范围B1:B10是输入数值的位置。输入这些值时,根据已经在相应单元格A1:A10中输入的数据,可以将它们设为正值或负值。因此,在B1中输入任何值(正数或负数)为1234或-1234,其中A1的值为“ B”都会导致B1显示-1234。相反,如果在单元格B1:B10中输入了正或负的任何值,并且列A中相应行的值为“ S”,则列B中的值将始终为正,而无论原始输入是负还是正。
如果在与B列中的同一行相对应的A1:A10范围内的特定单元格中没有值,则应该向用户显示一条消息,说:“请在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
这应该是您所需要的:
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
Sheet1
)。FirstRow
中到最后一个非空单元格。B
列中输入的值取决于A
列中的值。The代码
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