下面的代码可以使用vba来并发完成吗？

Question

这段代码用一个模板，产生2025年每天的日报表备用。

Sub saleReport()
    t1 = Timer()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim templatePath As String
    Dim oYear, oMonth, DaysInMonth As Integer
    templatePath = "d:\templateSale.xlsx"
    Set wb = Workbooks.Open(templatePath)
    Set ws = wb.Sheets(1)
    oYera = 2025
    For oMonth = 1 To 12
        DaysInMonth = Day(DateSerial(oYear, oMonth + 1, 1) - 1)
        For oDay = 1 To DaysInMonth
            fn = "2025年" + CStr(oMonth) + "月" + CStr(oDay) + "日的销售报表"
            newFilePath = "d:\" + fn + ".xlsx"
            ws.Name = fn
            wb.SaveAs Filename:=newFilePath, FileFormat:=xlOpenXMLWorkbook
        Next oDay
    Next oMonth
    wb.Close SaveChanges:=False
    Set wb = Nothing
    Set ws = Nothing
    t2 = Timer()
    Debug.Print t2 - t1
End Sub

程序运行了23秒。有无办法使用vba来并行调用我的4核cpu?将速度降低在几秒内？

Answer 1

Python或者c++这种多线程的语言试试，
用 Python multiprocessing 模块并发：

import openpyxl
from multiprocessing import Pool
import os
import datetime

def create_daily_report(date_tuple):
    year, month, day = date_tuple
    template_path = "d:\\templateSale.xlsx"
    new_file_name = f"{year}年{month}月{day}日的销售报表.xlsx"
    new_file_path = os.path.join("d:\\", new_file_name)

    workbook = openpyxl.load_workbook(template_path)
    worksheet = workbook.active
    worksheet.title = new_file_name
    # ... 根据日期修改工作表 ...

    workbook.save(new_file_path)
    workbook.close()
    print(f"已生成：{new_file_path}")

if __name__ == "__main__":
    year = 2025
    dates = []
    for month in range(1, 13):
        days_in_month = (datetime.date(year, month + 1, 1) - datetime.timedelta(days=1)).day if month < 12 else 31
        for day in range(1, days_in_month + 1):
            dates.append((year, month, day))

    # 4个进程的进程池
    with Pool(processes=4) as pool:
        pool.map(create_daily_report, dates)

    print("所有报表生成完毕！")

Answer 2

你这样的场景，可以使用多线程方式解决：

' 引入必要的Windows API函数声明
Private Declare PtrSafe Function CreateThread Lib "kernel32" ( _
    ByVal lpThreadAttributes As LongPtr, _
    ByVal dwStackSize As Long, _
    ByVal lpStartAddress As LongPtr, _
    lpParameter As Any, _
    ByVal dwCreationFlags As Long, _
    lpThreadId As LongPtr _
) As LongPtr

Private Declare PtrSafe Function CloseHandle Lib "kernel32" ( _
    ByVal hObject As LongPtr _
) As Long

' 定义一个自定义数据类型，用于传递参数给线程函数
Type ThreadParams
    TemplatePath As String
    YearValue As Integer
    MonthValue As Integer
    DayValue As Integer
    NewFilePath As String
End Type