Excel VBA：在工作表中填充数据时下拉列表为空

Question

我的 Excel VBA 代码遇到问题，当我在工作表中输入数据时，下拉列表变为空。我编写了一个宏来基于名为“listes_déroulantes”的单独工作表设置下拉列表，但是在将数据输入到表中后，主工作表中的下拉列表停止显示任何值。

这是我的代码的相关部分：

Sub EffacerPageName()
    ' Declare variables
    Dim ws As Worksheet
    Dim wsListes As Worksheet
    Dim lastRow As Long
    Dim tbl As ListObject
    
    ' Set the active sheet and the "listes_déroulantes" sheet
    Set ws = ActiveSheet
    Set wsListes = ThisWorkbook.Sheets("listes_déroulantes")
    
    ' Clear contents and formats from row 4 onwards
    ws.Rows("4:" & ws.Rows.Count).ClearContents
    ws.Rows("4:" & ws.Rows.Count).ClearFormats
    
    ' Delete all tables in the active sheet
    On Error Resume Next
    For Each tbl In ws.ListObjects
        tbl.Delete
    Next tbl
    On Error GoTo 0
    
    ' Add headers if missing
    With ws
        .Cells(3, 1).Value = "Mois"
        .Cells(3, 2).Value = "Promo"
        .Cells(3, 3).Value = "Code Analytique"
        .Cells(3, 4).Value = "Projet"
        .Cells(3, 5).Value = "Intervenant"
        .Cells(3, 6).Value = "Nombre d'heures" & Chr(10) & "d'intervention"
        .Cells(3, 7).Value = "Détail_Intervention"
        .Cells(3, 8).Value = "Statut"
        .Cells(3, 9).Value = "TVA"
        .Cells(3, 10).Value = "Taux horaire TTC ou" & Chr(10) & "brut"
        .Cells(3, 11).Value = "Total"
        .Cells(3, 12).Value = "Total-frais"
        .Cells(3, 13).Value = "Détail_Frais"
        .Cells(3, 14).Value = "Total-matériel"
        .Cells(3, 15).Value = "Détail_Matériel"
        
        ' Center headers and apply formatting
        .Range("A3:O3").HorizontalAlignment = xlCenter
        .Range("A3:O3").VerticalAlignment = xlCenter
        .Range("A3:O3").Font.Bold = True
        .Range("A3:O3").Font.Color = RGB(0, 0, 0)
        .Range("E3:K3").Interior.Color = RGB(226, 239, 218)
        .Range("L3:M3").Interior.Color = RGB(255, 242, 204)
        .Range("N3:O3").Interior.Color = RGB(217, 224, 242)
        .Columns("B").ColumnWidth = 30
        .Columns("A").NumberFormat = "mmm-yy"
    End With
    
    ' Create structured table
    With ws
        Dim tblRange As Range
        Set tblRange = .Range("A3:O3")
        Set tbl = .ListObjects.Add(xlSrcRange, tblRange, , xlYes)
        tbl.Name = "TableauEntetes"
        tbl.TableStyle = "TableStyleMedium2"
    End With

    ' Add data validations for drop-down lists
    lastRowPromo = wsListes.Cells(wsListes.Rows.Count, "A").End(xlUp).Row
    With ws.Range("B4:B" & ws.Rows.Count).Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=listes_déroulantes!A2:A" & lastRowPromo
        .IgnoreBlank = True
        .InCellDropdown = True
        .ShowInput = True
        .ShowError = True
    End With
    
    ' Repeat for other dropdowns...
End Sub

我有一个工作表，可以在其中输入各种数据，并且我已将 B、C、D、H 和 I 列中的下拉列表链接到“listes_déroulantes”工作表中的特定范围。 但是，当我开始输入数据时（特别是当我向下滚动行时），这些列中的下拉列表会清除并且不再显示任何选项。

Answer 1

您需要通过添加

$

 符号来使范围恒定

改变

.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=listes_déroulantes!A2:A" & lastRowPromo

到此

.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=listes_déroulantes!$A$2:$A$" & lastRowPromo