导入数据覆盖下拉列表数据答案

【问题标题】：Importing data overwriting drop down list data导入数据覆盖下拉列表数据
【发布时间】：2020-08-08 08:16:41
【问题描述】：

我正在使用下面的代码从另一个 excel 文件中导入 excel 中的数据。

我还在 C 列和 E 列上设置了下拉列表。当我运行此宏时，它会覆盖下拉列表数据。

如果用户没有导入正确的名称和城市，我希望它应该给出错误，并且还给出了那个 () 的建议？

如果我能实现这个逻辑，有没有可能。

Dim FileToOpen As String
Dim OpenBook As Workbook
Application.ScreenUpdating = False

Application.CutCopyMode = False
FileToOpen = Application.GetOpenFilename(Title:="Browse for your file")

If FileToOpen <> flase Then
Set OpenBook = Application.Workbooks.Open(FileToOpen)

OpenBook.Sheets(1).Range("A2:F21").Copy
ThisWorkbook.Worksheets("Data").Range("B4").PasteSpecial xlPasteValues

OpenBook.Close False
Application.CutCopyMode = False


End If

Application.ScreenUpdating = True

【问题讨论】：

.PasteSpecial xlPasteValues 如果粘贴的数据与数据验证列表数据不匹配，则不会触发错误。快速提问。所有单元格都具有相同的验证吗？
所有单元格的验证不同
我已经按照您的建议粘贴数据 ThisWorkbook.Worksheets("Data").Range("B4").PasteSpecial xlPasteValues
我可以轻松地花 30 分钟来编写代码和测试并发布解决方案，但这对您没有帮助... Google vba excel range to array 和 vba .Validation 和 vba .Formula1 然后试着想出一个代码。我们将从那里继续
另请参阅@MathieuGuindon 的THIS，您可以在我上面提到的逻辑中使用它来检查值是否满足条件......

标签： excel vba

【解决方案1】：

不知何故，在谷歌的帮助下，我能够实现我想要的。但我还有一些问题。

当我从下拉列表中手动选择数据并单击提交按钮时。它显示消息“无效的单元格值”

Dim isect As Range
Dim cell As Range
Dim dd As Variant
Dim i As Long
Dim mtch As Boolean
Dim msg As String
Dim myEntries As String
    
'   See if any updated cells fall in C4:C23
    Set isect = Intersect(Range("C4:C23"), Target)
    
'   Exit if updated cells do not fall in C4:C23
    If isect Is Nothing Then Exit Sub
    
    Application.EnableEvents = False
    
'   Set drop-down values
    dd = Array("A","B","C","D")
    
'   Loop through all intersecting cells
    For Each cell In isect
'       See if cell entry matches any drop-down values
        mtch = False
        For i = LBound(dd) To UBound(dd)
            If cell.Value = dd(i) Then
                mtch = True
                Exit For
            End If
        Next i
'       If value is not in list, erase and return message
        If mtch = False Then
            cell.ClearContents
            
           msg = "Invalid cell value"
        End If
    Next cell
    
'   Build string of validation entries
    For i = LBound(dd) To UBound(dd)
        myEntries = myEntries & dd(i) & ","
    Next i
    myEntries = Left(myEntries, Len(myEntries) - 1)
    
'   Reset validation
    With Range("C4:C23").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=myEntries
'        .IgnoreBlank = True
'        .InCellDropdown = True
'        .InputTitle = ""
'        .ErrorTitle = ""
'        .InputMessage = ""
'        .ErrorMessage = ""
'        .ShowInput = True
'        .ShowError = True
    End With
    
'   Return message, if necessary
    If Len(msg) > 0 Then
        MsgBox "Invalid entries in cells: " & vbCrLf & Left(msg, Len(msg) - 1), vbOKOnly, "ERROR!"
        Else
     
    End If

【讨论】：