时分秒00:00:00格式提取文件名和sheet名为00-00-00，实际变为小数了。

喜爱小娘子

我在帖子里找到了需要的，问题为：假设每个附件内D7单元格内为时间格式为16:19:10（这个时间每个excel都不一样），实际运行后提取为文件名变为小数0.679...，希望提取的文件名变为16-19-10格式，请大神帮忙修改代码，谢谢！

喜爱小娘子

乱码了，假设D7单元格均为时间格式16:19:10（这个时间每个excel都不一样），运行程序后文件名和sheet名都变成小数0.6799....，希望文件名和sheet名都变为16-19-10的格式，请大神帮忙修改代码。

喜爱小娘子

Sub Opiona()

'禁止系统刷屏?触发其他事件等
'On Error Resume Next    '// 发生错误，自动执行下一句，就是忽略错误
Application.ScreenUpdating = False '//关闭屏幕刷新
Application.DisplayAlerts = False '//关闭系统提示
Application.EnableEvents = False  '//禁止触发其他事件
t = Timer   '//开始时间

    PathG = ThisWorkbook.Path & "\结果"
    Set FSO = CreateObject("Scripting.FileSystemObject")
    If FSO.FolderExists(PathG) = True Then
        FSO.GetFolder(PathG).Delete   '//删除文件夹
    End If
   
    FileArr = FileAllArr(ThisWorkbook.Path, "*.xls?", ThisWorkbook.Name, True, False)
    MkDir PathG    '//创建文件夹
    For I = 0 To UBound(FileArr)
        Set WB = Workbooks.Open(FileArr(I))
        Set SHX = WB.Sheets(1)
        WB.SaveAs Filename:=PathG & "" & Replace(Replace(SHX.Range("G5").Value & "_" & SHX.Range("D6").Value & "_" & SHX.Range("D7").Value, "", "-"), "/", "-") & ".XLSX"
        WB.Close True  '//保存
    Next

Application.EnableEvents = True  '//  '//恢复触发其他事件
Application.ScreenUpdating = True '//恢复屏幕刷新
Application.DisplayAlerts = True '//恢复系统提示
MsgBox "一共用时：" & Format(Timer - t, "#0.0000") & " 秒", , "北极狐提示!!"  '//提示所用时间
End Sub

喜爱小娘子

没有大神在吗？！摸索几天论坛也没有找到相关帖子。

喜爱小娘子

完了，又沉了，没有一个帖子能完整的

喜爱小娘子

顶起来，这个问题论坛找一周都没有找到类似的，帮忙指点路径也行。

喜爱小娘子

绕个弯，问题自己解决了。
处理方法：加辅助列，用公式作出来00-00-00，然后提取辅助列的数据作为文件名，提取完后在清除辅助列数据。
虽然过程曲折，但还是达到了自己想要的结果，满满的成就感！！！