如果另一列中的值,则将excel宏应用于同一行中的单元格

时间:2016-12-05 21:01:18

标签: excel macros

我正在尝试将excel宏应用于单元格,如果同一行中存在某个值但位于不同的列中。例如,如果列A4具有“是”,则宏在A5上运行。

目前,我列出了我需要应用宏的每个单元格,但我不想每次需要添加另一个单元格时都要更改宏。

我现在的代码如下所示。

谢谢!

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
Dim lUsed As Long
Dim iselect As Range
If Target.Count > 1 Then GoTo exitHandler

On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitHandler

If rngDV Is Nothing Then GoTo exitHandler

If Intersect(Target, rngDV) Is Nothing Then
   'do nothing
Else
  Application.EnableEvents = False
  newVal = Target.Value
  Application.Undo
  oldVal = Target.Value
  Target.Value = newVal
  Set iselect = Application.Intersect(Target, Range("F28,F30,F77,F125,F176:F183,F185,F194,F196,F198:F205,F226,F364,F397,F400,F403,F451,F456,F545,F570,F572,F600,F605,F632,F638,F641,F646,F648,F673,F704,F706,F708,F712,F714,F716,F736,F765,F768,F798,F821,F823,F855,F884,F908,F947,F983:F984,F1009,F1015,F1026,F1033"))
  If Intersect(Target, iselect).Address = Target.Address Then
    If oldVal = "" Then
      'do nothing
      Else
      If newVal = "" Then
      'do nothing
      Else
        lUsed = InStr(1, oldVal, newVal)
        If lUsed > 0 Then
            If Right(oldVal, Len(newVal)) = newVal Then
                Target.Value = Left(oldVal, Len(oldVal) - Len(newVal) - 2)
            Else
                Target.Value = Replace(oldVal, newVal, "")
            End If
        Else
            Target.Value = oldVal _
              & "," & Chr(10) & newVal
        End If

      End If
    End If
  End If
End If

exitHandler:
  Application.EnableEvents = True
End Sub

0 个答案:

没有答案