excel vba做出一个打开文件对话框：

Posted 2023-03-21

选择文件后 自动复制打开表的数据到本工作薄，并关闭已经打开文件的文件！

Sub SelectFile()
Application.DisplayAlerts = False
fil = ThisWorkbook.Name
Filename = Application.GetOpenFilename("Excel 文件 ,*.xls;*.xlsx")
If Filename <> False Then
aFile = Split(Filename, "\\")
sfilename = aFile(UBound(aFile))
End If
Workbooks.Open (Filename)
Workbooks(sfilename).Sheets(1).Cells.Copy Workbooks(fil).Sheets(1).Cells
Workbooks(sfilename).Close
Application.DisplayAlerts = True
End Sub追问

更改文件名字还能用吗？

追答

可以啊，重新选择就行
你可以自己试试嘛

对了，这是默认复制第一个工作表的内容
如果需要复制其他的，更改这条
Workbooks(sfilename).Sheets(1).Cells.Copy Workbooks(fil).Sheets(1).Cells

追问

打开所有文件，更改哪个？还有 点取消 清除错误提示

追答

这只是打开一个指定的文件，如果是打开一个文件夹中的所有文件，就不需要用打开对话框了，直接指定文件夹，遍历所有文件就行了
取消错误，可以增加一句On error resume next

追问

我的意思是打开包括所有拓展名的。不是非得制定xls或者xlsx的，我有个文件是lag格式的能用excel打开，取消错误：On error resume next 加在哪里

追答

Sub SelectFile()
Application.DisplayAlerts = False
On Error Resume Next
fil = ThisWorkbook.Name
Filename = Application.GetOpenFilename("所有文件 ,*.*")
If Filename False Then
aFile = Split(Filename, "\\")
sfilename = aFile(UBound(aFile))
End If
Workbooks.Open (Filename)
Workbooks(sfilename).Sheets(1).Cells.Copy Workbooks(fil).Sheets(1).Cells
Workbooks(sfilename).Close
Application.DisplayAlerts = True
End Sub
这样就可以打开所有文件
但是，不能保证打开文件后能够正确复制
因为程序原理是复制Excel表格中的第一个工作表
如果复制对象不是Excel认可的格式，可能会出现找不到对象的错误。

参考技术A Sub 打开()
Application.Dialogs(475).Show '‘文件－打开’对话框
End Sub

vba excel怎么获取指定工作表的行数、列数

excel获取指定工作表的行数、列数的具体操作方法如下：

1.首先，打开Excel软件

2.打开源数据文件，假如需要根据证券代码显示出行业名称。现在，在I1单元格输入”证券代码“，在J1单元格输入”Nnindnme"。

3.如图，选中J2单元格，单击工具栏中的"插入函数“

4.弹出”插入函数“对话框，选择插入IF函数

5.在弹出的”函数参数“对话框中，设置Logical_test参数为”I2=“”，将Value_if_true设置为“”，在Value_if_false参数框中输入“VLOOKUP(I2,A2:B2846,2)，然后点击确定

参考技术A 当前工作表总行数
k=activesheet.usedrange.rows.count

指定sheet1工作表总列数
j=sheets("sheet1").usedrange.columns.count

前提是顶部和左侧无空行空列 参考技术B vba 取行数
Sheets（1）.[A65536].End(xlUp).Row '''该列最后一行
vba 取列数
Cells(14, 256).End(xlToLeft).Column'''该14行最后一列 参考技术C

列

Sub 列()

a = Columns("C:H").Count 'c:h的长度

b = Cells(1, Columns.Count).Address '列的最大值

c = Cells(1, Columns.Count).End(xlToLeft).Column '有效列(包含空值）

d = ActiveSheet.UsedRange.Columns.Count '有效列(包含空值）

f = Application.CountA(ActiveSheet.Range("1:1")) '有效列（到空值停止）

n = 12

g = Range(Chr(65 + n) & "1").Address '求第12列

End Sub

2.行

Sub 行()

a = Cells(Rows.Count, 1).Address '行的最大值

b = Cells(Rows.Count, 1).End(xlUp).Row  '有效行(包含空值）

c = ActiveSheet.UsedRange.Rows.Count '有效行(包含空值）

d = Application.CountA(ActiveSheet.Range("a:a")) '有效行（到空值停止）

End Sub