大家新年好，请把当文件夹里没有finished.xlsx略过修复一下

刷卡机电脑监控 · 发表于 2024-2-26 21:33

本帖最后由刷卡机电脑监控于 2024-2-27 16:42 编辑

一，VBA打开，所有日期文件夹下的Finished.xlsx

二，把finished.xlsx的《赛事表》数据复制到本文档里，并以该文件夹命名，

三，如果遇到该日期的表有了，自动跳过忽略。

四，复制到的数据，自动换行，居中，左对齐。

micch · 发表于 2024-2-26 21:54

先遍历文件夹，然后遍历文件，然后open文件，然后copy，然后判断工作表，然后新建后paste或者直接paste

刷卡机电脑监控 · 发表于 2024-2-26 21:59

micch 发表于 2024-2-26 21:54
先遍历文件夹，然后遍历文件，然后open文件，然后copy，然后判断工作表，然后新建后paste或者直接paste

论坛有这方面贴的资料吗

ykcbf1100 · 发表于 2024-2-26 22:00

楼主想尽快解决问题，还是摸拟一个附件上传吧。
没有附件，就这样空对空的，那其实是在浪费时间。

limonet · 发表于 2024-2-26 22:13

ykcbf1100 发表于 2024-2-26 22:00
楼主想尽快解决问题，还是摸拟一个附件上传吧。
没有附件，就这样空对空的，那其实是在浪费时间。

用量子传输，隔空取物。

刷卡机电脑监控 · 发表于 2024-2-26 22:14

micch 发表于 2024-2-26 21:54
先遍历文件夹，然后遍历文件，然后open文件，然后copy，然后判断工作表，然后新建后paste或者直接paste

已上传附件，谢谢

ykcbf1100 · 发表于 2024-2-26 22:15

limonet 发表于 2024-2-26 22:13
用量子传输，隔空取物。

还是你牛

ykcbf1100 · 发表于 2024-2-26 22:39

附件供参考。。。

ykcbf1100 · 发表于 2024-2-26 22:40

参与一下。。。

Sub ykcbf() '//2024.2.26
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim fld As New Collection
Set d = CreateObject("Scripting.Dictionary")
Set ws = ThisWorkbook
For Each sht In ws.Sheets
d(sht.Name) = ""
Next
p = ThisWorkbook.Path & ""
fn = "Finished.xlsx"
Set Fso = CreateObject("Scripting.FileSystemObject")
For Each f In Fso.GetFolder(p).SubFolders
fld.Add f.Name
Next
For Each fd In fld
If Not d.exists(fd) Then
Set sht = ws.Sheets.Add(After:=ws.Sheets(ws.Sheets.Count))
sht.Name = fd
f = p & fd & "" & fn
Set wb = Workbooks.Open(f, 0)
wb.Sheets("赛事").Cells.Copy sht.[a1]
With sht.UsedRange
.Borders.LineStyle = 1
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
wb.Close 0
End If
Next
Set d = Nothing
Application.ScreenUpdating = True
MsgBox "OK！"
End Sub

复制代码

刷卡机电脑监控 · 发表于 2024-2-26 22:54

ykcbf1100 发表于 2024-2-26 22:39
附件供参考。。。

测试可用，请问学了多久啊，这么快就能做出来

		自动登录	找回密码
密码			免费注册

[求助] 大家新年好，请把当文件夹里没有finished.xlsx略过修复一下

评分

评分