求详细解释

SubOPIONA()'OnErrorResumeNextDimxlBookAsExcel.WorkbookDimxlSheetAsExcel.WorksheetAppl... Sub OPIONA()
'On Error Resume Next
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Application.ScreenUpdating = False '关闭屏幕刷新
Application.DisplayAlerts = False '关闭提示
If MsgBox("需要操作的数据表是:EXCEL2003 格式,请选择:是!" & Chr(13) & "" & Chr(13) & "需要操作的数据表是:EXCEL2007 格式,请选择:否!", vbYesNo, "北极狐提示!!") = vbYes Then
S = "\*.xls"
ss = 4
Else
S = "\*.xlsx"
ss = 5
End If
t = Timer '记录开始时间
'---------------------------------------------------------------------------------
With Application.FileDialog(msoFileDialogFolderPicker) '使用对话框获得选择的文件夹名
.Show
Namefile = .SelectedItems(1)
End With
f = Dir(Namefile & S) '生成查找EXCEL的目录
'---------------------------------------------------------------------------------
n = 2 '开始记录工作簿名和工作表名的开始行
Do While f > " " '在目录中循环
If f <> ThisWorkbook.Name Then '如果不是打开的工作簿
Sheets(1).Cells(n, 1) = f
Sheets(1).Range("A" & n).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=Sheets(1).Cells(n, 1), TextToDisplay:="" & Sheets(1).Cells(n, 1) & ""
n = n + 1
End If
f = Dir
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "一共用时:" & Timer - t & " 秒", , "北极狐提示!!"
End Sub
展开
 我来答
crazy0qwer
2013-08-09 · TA获得超过3301个赞
知道大有可为答主
回答量:4020
采纳率:71%
帮助的人:1324万
展开全部

连代码也给你优化下吧。

原来的代码不能执行吧?

Sub OPIONA()
    Application.ScreenUpdating = False '关闭屏幕刷新
    Application.DisplayAlerts = False '关闭提示
    
    With Application.FileDialog(msoFileDialogFolderPicker) '使用对话框获得选择的文件夹名
        If .Show Then    '显示 选择文件夹 对话框,并判断用户是否选择了文件夹。
            Namefile = .SelectedItems(1) & "\"  '获取选择的文件夹路径
        End If
    End With
    
    f = Dir(Namefile & "*.xls*")   '查找第一个文件。
    N = 2 '开始记录工作簿名和工作表名的开始行
    
    Do Until Len(f) = 0  '循环查找,直到没有找不到文件
        If f <> ThisWorkbook.Name Then '如果不是打开的工作簿
            '在当前活动的工作表中添加超链接,超链接的文件是找到的文件,超链接显示的是文件的名称
            ActiveSheet.Hyperlinks.Add Sheets(1).Range("A" & N), Namefile & "\" & f, , , f
            N = N + 1  '写入的行号加一
        End If
        f = Dir    '查找下一个文件
    Loop
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
追问
大哥这个是可以用了,上面的代码是从第一张工作表中的第一列第二行开始写入的,不过我想要改成,写入的是“数据”这张工作表中的第3列第2行开始。”“我的工作表的标签名改成了中文名称“数据”两个字而不是默认的SHEET1"望帮帮忙,多谢了,急呵呵。
推荐律师服务: 若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询

为你推荐:

下载百度知道APP,抢鲜体验
使用百度知道APP,立即抢鲜体验。你的手机镜头里或许有别人想知道的答案。
扫描二维码下载
×

类别

我们会通过消息、邮箱等方式尽快将举报结果通知您。

说明

0/200

提交
取消

辅 助

模 式