通过窗体实现人机交互，选定工作簿实现数据字典查找

vleexhya

多谢各位老师的帮助!
需求：



实际工作中数据源表格是关闭的,但结果1,结果2,结果3工作簿是打开的,宏在专门的“宏在此表运行xlsm"运行。


运行宏时遍历打开的工作簿,  弹出窗体显示有结果1,结果2,结果3工作簿打开了,询问对哪个工作簿进行查找写入, 用户选定后, 根据用户选定工作簿的姓名,将查找结果写入用户选定的工作簿的成绩栏。
感谢小凡老师昨天的帮助，今天试了一下，还是要求助各位老师！


补充：其实这个应用场景就是将查找结果写到表的对应位置，但不想表里有宏，而且这个表只是格式固定，表不是我的，也不能提前在里面写宏。不知道各位老师对这种应用场景有没有其他好的操作策略？

ykcbf1100

既然用VBA，那保存的结果表没必要先打开，只要手动选中哪个文件后，其它交代码去做就行了。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.8.27
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     Set fso = CreateObject("Scripting.FileSystemObject")
   
5.     p = ThisWorkbook.Path & ""
   
6.     f = p & "数据源.xlsx"
   
7.     Set wb = Workbooks.Open(f, 0)
   
8.     arr = wb.Sheets(1).UsedRange
   
9.     wb.Close 0
   
10.     With Application.FileDialog(msoFileDialogFilePicker)
    
11.         .InitialFileName = ThisWorkbook.Path & ""
    
12.         .Title = "请选择要保存的Excel文件"
    
13.         .AllowMultiSelect = False
    
14.         .Filters.Clear
    
15.         .Filters.Add "Excel文件", "*.xls*"
    
16.         If .Show Then f = .SelectedItems(1) Else Exit Sub
    
17.     End With
    
18.     Set wb = Workbooks.Open(f, 0)
    
19.     wb.Sheets(1).[a1].Resize(UBound(arr), UBound(arr, 2)) = arr
    
20.     wb.Close 1
    
21.     Application.ScreenUpdating = False
    
22.     MsgBox "OK！"
    
23. End Sub
    
24. 
    

复制代码

3190496160

有必要这么复杂繁琐吗？？

vleexhya

ykcbf1100 发表于 2024-8-27 11:27
既然用VBA，那保存的结果表没必要先打开，只要手动选中哪个文件后，其它交代码去做就行了。

多谢草爷帮助！实际结果表中还有其他数据，而且是打开的，也不想在结果表里有宏在。

vleexhya

3190496160 发表于 2024-8-27 11:31
有必要这么复杂繁琐吗？？

多谢老师帮助！其实这个应用场景就是将查找结果写到表的对应位置，但不想表里有宏，而且这个表只是格式固定，表不是我的，不能提前在里面写宏。

ykcbf1100

vleexhya 发表于 2024-8-27 11:44
多谢草爷帮助！实际结果表中还有其他数据，而且是打开的，也不想在结果表里有宏在。

结果表不需要有宏。
你摸拟的结果应该尽量真实，不然，拿到的代码以后还得修改，浪费时间。

3190496160

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim ar As Variant
Dim d As Object
Set d = CreateObject("scripting.dictionary")
For i = 0 To ListBox1.ListCount - 1
    If ListBox1.Selected(i) = True Then
        wj = ListBox1.List(i, 0)
        Exit For
    End If
Next i
lj = ThisWorkbook.Path & "\"
f = Dir(lj & "数据源.xlsx")
If f = "" Then MsgBox "找不到数据源文件！": Exit Sub
Set wb = Workbooks.Open(lj & f, 0)
ar = wb.Worksheets(1).[a1].CurrentRegion
wb.Close False
For i = 2 To UBound(ar)
    If ar(i, 1) <> "" Then
        d(ar(i, 1)) = i
    End If
Next i
Set wb = Nothing
Windows(wj).Activate
br = ActiveWorkbook.Worksheets(1).[a1].CurrentRegion
For i = 2 To UBound(br)
    If br(i, 1) <> "" Then
        xh = d(br(i, 1))
        If xh <> "" Then
            br(i, 2) = ar(xh, 2)
        End If
    End If
Next i
ActiveWorkbook.Worksheets(1).[a1].CurrentRegion = br
End Sub
Private Sub UserForm_Initialize()
Dim wb As Workbook
Dim br()
ReDim br(1 To 3, 1 To 1)
For Each wb In Workbooks
    If wb.Name <> ThisWorkbook.Name And InStr(wb.Name, "数据源") = 0 Then
        n = n + 1
        br(n, 1) = wb.Name
    End If
Next wb
If n = "" Then MsgBox "请先打开结果文件！": Exit Sub
ListBox1.List = br
End Sub

3190496160

2.rar (43.69 KB, 下载次数: 13)

2024-8-27 11:55 上传

点击文件名下载附件

vleexhya

ykcbf1100 发表于 2024-8-27 11:52
结果表不需要有宏。
你摸拟的结果应该尽量真实，不然，拿到的代码以后还得修改，浪费时间。

老师说的对！我主要是请教窗体这方面，害怕耽误老师们过多时间，其他方面的数据做的简单。