单元格模糊、智能、联想输入的下拉菜单

每天学一点。

1.B3 单元格模糊、智能、联想输入的下拉菜单,数据来源于sheet数据表B列,要去重复值

2.如果查不到数据B3为空,B3、B4、F3可填写数据
3.B3单元格查到数据,B4、F3单元格自动填入数据,数据来源于sheet数据表

kdsea

Private Sub Worksheet_SelectionChange(ByVal Target As Range) '字典下拉事件 Set dict = CreateObject("Scripting.Dictionary") Dim cell As Range Dim lastRow As Long Dim i As Long Dim theList As String  If Intersect(Target, Range("C2:C500")) Is Nothing Then Exit Sub       With Sheets("字典")         lastRow = .Range("A" & Rows.Count).End(xlUp).Row         For i = 2 To lastRow             If Not dict.Exists(.Range("A" & i).Value) Then                 dict.Add .Range("A" & i).Value, .Range("D" & i).Value             End If         Next i     End With          ' 将字典的键转换为用逗号隔开的字符串格式     Dim arr As Variant: arr = dict.Keys     theList = Join(arr, ",")     If Target.Column = 3 Then         If the = "" Then             ' 如果可选项为空，则删除现有验证并允许手输入             Target.Validation.Delete             Target.Validation.Add Type:=xlValidateText, AlertStyle:=xlValidAlertStop         Else             ' 如果有可选项，则将字典的键作为下拉列表的选项             Target.Validation.Delete             Target.Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertWarning, _                 Formula1:=theList         End If     End If  End Sub

kdsea

Private Sub Worksheet_SelectionChange(ByVal Target As Range) '字典下拉事件
Set dict = CreateObject("Scripting.Dictionary")
Dim cell As Range
Dim lastRow As Long
Dim i As Long
Dim theList As String

If Intersect(Target, Range("C2:C500")) Is Nothing Then Exit Sub


    With Sheets("字典")
        lastRow = .Range("A" & Rows.Count).End(xlUp).Row
        For i = 2 To lastRow
            If Not dict.Exists(.Range("A" & i).Value) Then
                dict.Add .Range("A" & i).Value, .Range("D" & i).Value
            End If
        Next i
    End With
   
    ' 将字典的键转换为用逗号隔开的字符串格式
    Dim arr As Variant: arr = dict.Keys
    theList = Join(arr, ",")
    If Target.Column = 3 Then
        If the = "" Then
            ' 如果可选项为空，则删除现有验证并允许手输入
            Target.Validation.Delete
            Target.Validation.Add Type:=xlValidateText, AlertStyle:=xlValidAlertStop
        Else
            ' 如果有可选项，则将字典的键作为下拉列表的选项
            Target.Validation.Delete
            Target.Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertWarning, _
                Formula1:=theList
        End If
    End If

End Sub  参考这段代码吧

3190496160

这个得用文本框控件+列表框控件才能实现你的需求，不难，但是，繁琐，先留个记号吧

每天学一点。

我用文本框控件+列表框控件做了一个
B3单元格为今合并单元格无法实现,解开后可实现

每天学一点。

3190496160 发表于 2024-4-17 16:46
这个得用文本框控件+列表框控件才能实现你的需求，不难，但是，繁琐，先留个记号吧

谢谢  文本框控件+列表框控件做了一个 B3单元格为今合并单元格无法实现,解开后可实现

3190496160

每天学一点。 发表于 2024-4-17 16:57
谢谢  文本框控件+列表框控件做了一个 B3单元格为今合并单元格无法实现,解开后可实现

每天学一点。

kdsea 发表于 2024-4-17 15:30
Private Sub Worksheet_SelectionChange(ByVal Target As Range) '字典下拉事件
Set dict = CreateObject( ...

非常感谢回复，代码刚学，能付帮我写个

wcj6376tcp

每天学一点。 发表于 2024-4-17 20:05
非常感谢回复，代码刚学，能付帮我写个

Sub 自动生成单据编号()
    Dim stName, Rows, num
    stName = "数据"
    Rows = Sheets(stName).Range("B1").CurrentRegion.Rows.Count '获取行数
    Range("B2") = Format(Date, "yyyy-mm-dd") '生成系统时间
    With Sheets("付款申请单")
      Cells(3, 6).Value = Application.WorksheetFunction.VLookup(Cells(3, 2), Sheets(stName).Range("B2:G" & Rows), 3, 0)    '匹配开户行
      Cells(4, 2).Value = Application.WorksheetFunction.VLookup(Cells(3, 2), Sheets(stName).Range("B2:G" & Rows), 2, 0)    '匹配账号
      Cells(5, 2).Value = Application.WorksheetFunction.VLookup(Cells(3, 2), Sheets(stName).Range("B2:G" & Rows), 4, 0)    '匹配用途
      Cells(7, 8).Value = Application.WorksheetFunction.VLookup(Cells(3, 2), Sheets(stName).Range("B2:G" & Rows), 6, 0)    '匹配金额
      num = Cells(7, 8).Value
      Cells(7, 2).Value = DX(num)    '大写
    End With
End Sub
Function DX(M) '人民币大写  163字符A 无缺陷 负数显示 “负”
    DX = Replace(Replace(Replace(Join(Application.Text(Split(Format(M, " 0. 0 0;负 0. 0 0; ")), ["[DBnum2]"&{0,"","元0角;;元零","0分;;整"}]), a), "零元零", a), "零元", a), "零整", "整")
End Function

wcj6376tcp

每天学一点。 发表于 2024-4-17 20:05
非常感谢回复，代码刚学，能付帮我写个

考虑金额估计是重新输入，给你改了一点