VBA获取月份数据源合并到一个工作表

杨大敏 · 发表于 2024-1-21 14:54

shiruiqiang 发表于 2024-1-20 08:43
建议添加个工作簿的名称。
选择文件夹，汇总

老师您好，你这边的附件论坛可以下载了，测试一下，距离主题还少一点功能。

1.测试只能获取2023年12月份和2024年1月份的数据清单，2023年11月份以前到2023年6月份的数据获取失败，需要全部月份的数据清单都能单独获取。

2.当前执行VB代码是选择某个文件夹作为数据源获取，需要在VB代码里指定一个路径获取“故障源"，后续我自行修改VB代码里面的路径信息。VB路径修改位置帮忙注释一下谢谢。减少文件夹选择。

3.drr行数定义1000000执行出内存溢出错误，我改为drr=10000行数才可以执行VB程序，你看这里需要修改一下吗？

我这里附件数据源更全，老师请查收。

杨大敏 · 发表于 2024-1-21 18:04

shiruiqiang 发表于 2024-1-20 15:29
等审核

老师你好，我测试了你得回复附件，已经可以下载打开了，还存在点问题：

1.测试了2024年1月份和2023年12月份的数据源获读取成功，但是2023年11月份（包含11月）以前的数据都获取失败，也需要获取2024年以前的月份数据。

2.数据源获取，帮忙改为固定路径吧，当前每次都弹出对话框去选择文件夹，其它同事觉得麻烦，VB代码帮忙固定一个路径，后续我更新VB代码路径来更新数据源位置。

3.brr定义行数100000运行错误“内存溢出”报警，我删除为brr=10000才可以运行程序，这里代码是否需要完善一下。

我这里更新数据源数据有2023年6月份 - 2024年1月份，老师帮忙更改一下以上问题谢谢。

ykcbf1100 · 发表于 2024-1-21 21:50

Sub ykcbf() '//2024.1.21
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim arr, brr(1 To 100000, 1 To 100), d
Dim tm: tm = Timer
Set fso = CreateObject("Scripting.FileSystemObject")
Set d = CreateObject("Scripting.Dictionary")
Set sh = ThisWorkbook.Sheets("工单列表")
yf = Format(ThisWorkbook.Sheets("汇总").[g1], "yyyymm")
With sh
c = .UsedRange.Columns.Count
For j = 2 To c + 1
n = n + 1
s = .Cells(1, j)
d(s) = n
Next
End With
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "请选择文件夹"
.InitialFileName = ThisWorkbook.Path & ""
If .Show = -1 Then
p = .SelectedItems(1) & ""
End If
End With
On Error Resume Next
For Each f In fso.GetFolder(p).Files
If f.Name Like "*.xls*" Then
If InStr(f.Name, ThisWorkbook.Name) = 0 Then
fn = fso.GetBaseName(f)
rq = Left(Replace(fn, "故障清单", ""), 6)
If rq = yf Then
Set wb = Workbooks.Open(f, 0)
With wb.Sheets(1)
arr = .UsedRange
wb.Close False
End With
For i = 2 To UBound(arr)
If arr(i, 1) <> Empty Then
m = m + 1
For j = 1 To UBound(arr, 2)
s = arr(1, j)
If d.exists(s) Then
brr(m, d(s)) = arr(i, j)
End If
Next
End If
Next
End If
End If
End If
Next f
With sh
.UsedRange.Offset(1).Clear
With .[b2].Resize(m, n)
.Value = brr
.Borders.LineStyle = 1
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
End With
Set d = Nothing
Application.ScreenUpdating = True
MsgBox "共用时：" & Format(Timer - tm) & "秒！"
End Sub

复制代码

参与一下，代码以附件为准。

ykcbf1100 · 发表于 2024-1-21 21:51

杨大敏发表于 2024-1-21 18:04
老师你好，我测试了你得回复附件，已经可以下载打开了，还存在点问题： 1.测试了2024年1月份和2023年12月 ...

附件供参考。。。

杨大敏 · 发表于 2024-1-22 00:42

ykcbf1100 发表于 2024-1-21 21:51
附件供参考。。。

非常感谢老师的答复，已经完成题目90%吻合了，太感谢了。

完成了日期G1指定，完成工单列表标题指定。

还需要补充一点：

假设需要指定固定的位置来作为数据源位置查找，我应该用那一段程序替代为数据源路径才可以；比如我数据源位置为“D:\重要文件\Desktop\新建文件夹\故障汇报\故障清单”。

或者把“汇总表”H1单元格作为数据源查找位置这样可以吗，如下面图片这样这样可以吗？

感谢老师的回答，鲜活2朵必须赠送。

ykcbf1100 · 发表于 2024-1-22 07:30

杨大敏发表于 2024-1-22 00:42
非常感谢老师的答复，已经完成题目90%吻合了，太感谢了。完成了日期G1指定，完成工单列表标题指定。还需 ...

指定文件夹

ykcbf1100 · 发表于 2024-1-22 07:36

[h1]单元格指定路径

杨大敏 · 发表于 2024-2-29 11:41

ykcbf1100 发表于 2024-1-22 07:36
[h1]单元格指定路径

老师你好，指定单元格h1，已经满足要求了非常感谢。

有时还需要获取数据源“全年数据”，帮忙指导一下修改那句代码可以获取2024年全年数据。

就是h1指定的日期，获取全年的数据，目前是只能获取2024年和月份。

如果不方便解答，直接回复附件也可以。

fzxba · 发表于 2024-2-29 13:41

12F附件参与一下.rar (1.7 MB, 下载次数: 11)

ykcbf1100 · 发表于 2024-2-29 13:49

杨大敏发表于 2024-2-29 11:41
老师你好，指定单元格h1，已经满足要求了非常感谢。

有时还需要获取数据源“全年数据”，帮忙指导一下 ...

代码已更新，即可以按年+月汇总，也可以按全年汇总。开始时选择汇总方式，默认是按年+月汇总。文件夹路径改为动态选择，避免以后路径发生变化后也可以不改代码。总表[h1]路径取消。

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

[求助] VBA获取月份数据源合并到一个工作表

评分

评分

评分

评分

评分

评分