Question

我在更改单元格时触发了一些VBA代码。如果同一行的A列中有值，则代码的一部分会在C列中创建一个下拉列表。下拉代码有两件事我想得到一些帮助。

首先：如果我将某些行的下拉值更改为“是”（默认情况下设置为“否”）然后在列A中添加新值所有下拉列表：s将值更改为“否”。我想添加某种类型检查，如果该值设置为是，请不要将其更改回来。

第二：看起来像某种bug，所以我会发布我的所有代码以防其他可能导致它。假设我在A列中添加了五行的值，并删除了它们（如果我一个接一个地删除它们或者同时删除所有五个，也不删除它们的顺序）。在删除A列中的最后一个值之后，C列中的标题会得到一个下拉列表（请注意，A列也有一个未删除的标题。

Private Sub Worksheet_Change(ByVal Target As Range)
  If Intersect(Target, Me.Range("A:A")) Is Nothing Then Exit Sub
  Application.EnableEvents = False 'to prevent endless loop
  On Error GoTo Finalize 'to re-enable the events

  For Each columnAcell In Target.Cells
      columnAcell.Offset(0, 3) = Mid(columnAcell, 2, 3)
      If IsEmpty(columnAcell.Value) Then columnAcell.Offset(0, 4).ClearContents
      If IsEmpty(columnAcell.Value) Then columnAcell.Offset(0, 2).Clear
      If IsEmpty(columnAcell.Value) Then columnAcell.Offset(0, 1).Clear
      If IsEmpty(columnAcell.Value) Then columnAcell.Offset(0, 5).Clear
  Next

  Application.ScreenUpdating = False

  Dim w1 As Worksheet, w2 As Worksheet
  Dim c As Range, FR As Variant

  Set w1 = Workbooks("Configure Accesspoints.xlsm").Worksheets("AP_Input")
  Set w2 = Workbooks("Configure Accesspoints.xlsm").Worksheets("Data")

  For Each c In w1.Range("D2", w1.Range("D" & Rows.Count).End(xlUp))
      FR = Application.Match(c, w2.Columns("A"), 0)
      If IsNumeric(FR) Then c.Offset(, 1).Value = w2.Range("B" & FR).Value
  Next c

  For Each c In w1.Range("D2", w1.Range("D" & Rows.Count).End(xlUp))
      FR = Application.Match(c, w2.Columns("A"), 0)
      If IsNumeric(FR) Then c.Offset(, 2).Value = w2.Range("D" & FR).Value
  Next c

  Dim myList As String, r As Range

      myList = "Yes,No"

  For Each r In w1.Range("A2", w1.Range("A" & Rows.Count).End(xlUp))
      If r.Value <> vbNullString Then
         With r.Offset(, 2).Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:=myList
         End With
         r.Offset(, 2).Value = Split(myList, ",")(1)
      End If
  Next r

Finalize:
  Application.EnableEvents = True
End Sub

Answer 1

首先，让VBA记住C列中的旧值。您可以将其设置回来。

将myList命名为String，r As Range

myList = "Yes,No"
Dim oldYesNo As String
For Each r In w1.Range("A2", w1.Range("A" & Rows.Count).End(xlUp))
    If r.Value <> vbNullString Then
        If oldYesNo <> vbNullString Then oldYesNo = r.Offset(, 2)
        With r.Offset(, 2).Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:=myList
        End With
        If oldYesNo = vbNullString Then r.Offset(, 2).Value = Split(myList, ",")(1)
        oldYesNo = vbNullString
    End If
Next r

第二个问题不是错误。 VBA完全按照您的说法行事：

For Each r In w1.Range("A2", w1.Range("A" & Rows.Count).End(xlUp))

如果只有A1单元格填充，则仅适用于A1单元格。你可以添加一个条件;

If w1.Range("A" & Rows.Count).End(xlUp).Address <> "$A$1" Then

编辑：在第二个，但是，记住旧值是没有必要的。足够的是只为新行设置值。

myList = "Yes,No"

If w1.Range("A" & Rows.Count).End(xlUp).Address <> "$A$1" Then
    For Each r In w1.Range("A2", w1.Range("A" & Rows.Count).End(xlUp))
        If r.Value <> vbNullString Then
            With r.Offset(, 2).Validation
                .Delete
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:=myList
            End With
            if r.Offset(, 2).Value = "" Then Split(myList, ",")(1)
        End If
    Next r
End If

也许有更优雅的解决方案，但无论如何这都应该有效。

Excel VBA下拉菜单

1 个答案: