求助！窗体

zjnbzjg

单击EXCELsheet1中某列中的单元格，弹出窗体（窗体显示sheet2数据表中A列的内容）鼠标选择其中数据后自动填入点击的单元格。谢谢！

liulang0808

欢迎新朋友，建议上传附件，举例说明下需求

池盛龙

代码分享：
'2020-02-03 池盛龙
Public Conn As Object, rs As Object
    Public strConn As String, strSQL As String
    Public i As Integer, PathStr As String
    Public Sub LJSJK()
    Set Conn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")
    PathStr = ThisWorkbook.FullName   '设置工作簿的完整路径和名称
    Select Case Application.Version * 1    '设置连接字符串,根据版本创建连接
    Case Is <= 11
        strConn = "Provider=Microsoft.Jet.Oledb.4.0;Extended Properties=excel 8.0;Data source=" & PathStr
    Case Is >= 12
        strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & PathStr & ";Extended Properties=""Excel 12.0;HDR=YES"";"""
    End Select
    '设置SQL查询语句
        Conn.Open strConn    '打开数据库链接
End Sub
Public Sub GBSJK()
  rs.Close    '关闭数据库连接
    Conn.Close
End Sub
Public Sub GBLJ()
    Set Conn = Nothing
    Set rs = Nothing
End Sub

Private Sub CommandButton1_Click() '搜索

Sql = "SELECT  * FROM [sheet2$] where 标题 like '%" & Me.TextBox1 & "%'"    '将【标题】改成你实际的列标题
Call LJSJK     '连接符丢失重新连接
    rs.Open Sql, Conn, 1, 1
     If rs.RecordCount > 0 Then
       ListBox1.Column = rs.GetRows
    Else
        ListBox1.Clear
    End If
  Call GBSJK
   Call GBLJ

End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) '双击事件
Call 选入
End Sub

Private Sub TextBox1_Change()
Call CommandButton1_Click
End Sub

Private Sub UserForm_Initialize() '初始化
Sql = "SELECT  * FROM [sheet2$] " '工作表sheet2改成你实际的工作表名称
Call LJSJK     '连接符丢失重新连接
    rs.Open Sql, Conn, 1, 1
     If rs.RecordCount > 0 Then
       ListBox1.Column = rs.GetRows
    Else
        ListBox1.Clear
    End If
  Call GBSJK
   Call GBLJ
End Sub
Sub 选入()
HS = Selection.Row '鼠标选择单元格行数
LS = Selection(Selection.Count).Column '鼠标选择单元格列数
Cells(HS, LS) = ListBox1.List(ListBox1.ListIndex, 0)
Me.Hide '隐藏窗体
End Sub

池盛龙

附件如下。期待鲜花

zjnbzjg

单击单元格，弹出数据框（数据在SHEET2中）鼠标选择数据后填入刚才单击的单元格

zjnbzjg

池盛龙 发表于 2020-2-3 21:38
附件如下。期待鲜花

谢谢！还不是我想要的那种

zjnbzjg

池盛龙 发表于 2020-2-3 21:38
附件如下。期待鲜花

请问：如何把鼠标双击改为单击，谢谢！

zjnbzjg

池盛龙 发表于 2020-2-3 21:38
附件如下。期待鲜花

单击问题已经解决，谢谢！如果再增加二个用户窗口实现相同功能（调用不同的SHEET内容），代码如何编辑，我把你的代码拷过去没用，请赐教！

zjnbzjg

zjnbzjg 发表于 2020-2-4 09:45
单击问题已经解决，谢谢！如果再增加二个用户窗口实现相同功能（调用不同的SHEET内容），代码如何编辑， ...

修改过数据位置

zjnbzjg

池盛龙 发表于 2020-2-3 21:38
附件如下。期待鲜花

单击问题已经解决，谢谢！如果再增加二个用户窗口实现相同功能（调用不同的SHEET内容），代码如何编辑，我把你的代码拷过去修改过数据位置没用，请赐教！