[已解决]如何提速课表中VBA运行的速度

zhy0911 · 发表于 2021-3-11 20:18

初学VBA，利用VBA做了个课表，但在提取教师课表和班级课表时，运行速度太慢，请教各位大神，帮忙改一下，如何提高一下运行速度，谢谢了！

最佳答案

月排行榜 / 总排行榜

grf1973

2021-3-12 10:27

在教师表和班级表里做了个有效性下拉。

跳转到最佳答案楼层

grf1973 · 发表于 2021-3-12 09:44

用字典和数组代替单元格的比较

Sub 插入教师姓名()
Set d = CreateObject("scripting.dictionary")
arr = Worksheets("教师课务安排").[a1].CurrentRegion
For i = 3 To UBound(arr)
d(arr(i, 3) & arr(i, 4)) = arr(i, 2) '建立班级+科目与老师的对应关系
Next
With Worksheets("总课表")
h = .[a65536].End(xlUp).Row + 1
brr = .Range("A4:BD" & h)
For i = 1 To UBound(brr) Step 2
For j = 2 To UBound(brr, 2)
brr(i + 1, j) = d(brr(i, 1) & brr(i, j)) '根据《总课表》的班级+科目找到对应的老师
Next
Next
.Range("A4:BD" & h) = brr
End With
End Sub

复制代码

grf1973 · 发表于 2021-3-12 10:13

Sub 显示教师课表()
Set d = CreateObject("scripting.dictionary")
With Worksheets("总课表")
h = .[a65536].End(xlUp).Row + 1
brr = .Range("A2:BD" & h)
For j = 2 To UBound(brr, 2)
If brr(1, j) = "" Then brr(1, j) = brr(1, j - 1) '把合并单元格的星期也放到数组里
Next
For i = 3 To UBound(brr) Step 2
For j = 2 To UBound(brr, 2)
js = brr(i + 1, j) '教师
d(js & brr(1, j) & brr(2, j)) = brr(i, 1) & Chr(10) & brr(i, j) 'd(教师+星期+节次)=班级+回车键+科目
Next
Next
End With
With Sheets("教师个人课表")
js = .[c5]
arr = .[a7:h18]
For i = 2 To UBound(arr)
For j = 3 To UBound(arr, 2)
arr(i, j) = d(js & arr(1, j) & arr(i, 2)) '班级+回车键+科目=d(教师+星期+节次)
Next
Next
.[a7:h18] = arr
End With
End Sub

复制代码

grf1973 · 发表于 2021-3-12 10:18

班级课表和教师课表基本一致

Sub 显示班级课表()
Set d = CreateObject("scripting.dictionary")
With Worksheets("总课表")
h = .[a65536].End(xlUp).Row + 1
brr = .Range("A2:BD" & h)
For j = 2 To UBound(brr, 2)
If brr(1, j) = "" Then brr(1, j) = brr(1, j - 1) '把合并单元格的星期也放到数组里
Next
For i = 3 To UBound(brr) Step 2
bj = brr(i, 1)
For j = 2 To UBound(brr, 2)
d(bj & brr(1, j) & brr(2, j)) = brr(i, j) & Chr(10) & brr(i + 1, j) 'd(班级+星期+节次)=科目+回车键+教师
Next
Next
End With
With Sheets("班级课程表")
bj = .[c5]
arr = .[a7:h18]
For i = 2 To UBound(arr)
For j = 3 To UBound(arr, 2)
arr(i, j) = d(bj & arr(1, j) & arr(i, 2)) '科目+回车键+教师=d(班级+星期+节次)
Next
Next
.[a7:h18] = arr
End With
End Sub

复制代码

grf1973 · 发表于 2021-3-12 10:27

这个最佳答案由 grf1973 给出，感谢 grf1973 的回答。

单击隐藏图章

在教师表和班级表里做了个有效性下拉。

0126 · 发表于 2021-3-12 13:29

Sub 显示教师课表()
Dim i As Integer, li As Integer, jskb As Worksheet, arr, brr(1 To 11, 1 To 6) As String, js As String

arr = Worksheets("总课表").Range("a1").Resize(Worksheets("总课表").Cells(Rows.Count, 2).End(xlUp).Row, 58)
Set jskb = Worksheets("教师个人课表")
js = jskb.Range("c5").Value

For i = 5 To UBound(arr) Step 2
               If arr(i, 2) = js Then brr(10, 6) = arr(i - 1, 1) & Chr(10) & arr(i - 1, 2)
               If arr(i, 3) = js Then brr(11, 6) = arr(i - 1, 1) & Chr(10) & arr(i - 1, 3)
   For l1 = 4 To 58
            If arr(i, l1) = js Then
               brr(((l1 - 4) Mod 11) + 1, (l1 - 4) \ 11 + 1) = arr(i - 1, 1) & Chr(10) & arr(i - 1, l1)
            End If
   Next l1
Next i

With jskb.Range("c8").Resize(UBound(brr), UBound(brr, 2))
   .ClearContents
   .Value = brr
End With
End Sub

提存放单元格数据会影响速度，尽量少处理单元格，速度就提升了，要是禁止公式自动计算和事件响应，那你的程序是可以提升一些速度
Application.Calculation = IIf(jz, xlAutomatic, xlManual) '设置工作表公式计算为手动模式
Application.EnableEvents = false '禁止工作表事件

zhy0911 · 发表于 2021-3-15 07:23

谢谢各位大神，我马上去试试！

zhy0911 · 发表于 2021-3-15 10:49

grf1973 发表于 2021-3-12 10:27
在教师表和班级表里做了个有效性下拉。

请问一下大神，我现在想在《教师课程表》和《班级课程表》中通过教师姓和班级进行批量打印，代码该怎么写，原来用函数做的课表，批量打印代码不能用了。谢谢了！

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