用VBA根据条件自动填充

fgq5910 · 发表于 2023-12-17 11:51

本帖最后由 fgq5910 于 2023-12-17 19:55 编辑

需求：
用VBA根据条件自动填充
根据表1的填充条件，把表1的[K]、[L]、[M]三列自动填充
F栏（授课教师）里为空，不填充
表2是想要的结果
如：
F3：有数据，K3,L3、M3分别       为教室、专题
F4:有数据， K4,L4、M4分别       为市内、现场教学、会址
F5 ：为空，K5,L5、M5分别为空
谢谢！

用VBA根据条件自动填充.zip (17.18 KB, 下载次数: 29)

沈默00 · 发表于 2023-12-17 12:48

这个什么逻辑，也没看明白

excel玉米 · 发表于 2023-12-17 12:59

fgq5910 · 发表于 2023-12-17 13:04

excel玉米发表于 2023-12-17 12:59

非常感谢！
正是我想要的效果

ykcbf1100 · 发表于 2023-12-17 14:03

参与一下。。。

Sub ykcbf() '//2023.12.17
Dim arr, zrr, d
Set d = CreateObject("Scripting.Dictionary")
With Sheets("表1")
r1 = .Cells(Rows.Count, "q").End(3).Row
zrr = .Range("p1:t" & r1)
r = .Cells(Rows.Count, 1).End(3).Row
arr = .Range("a3:m" & r)
End With
For i = 3 To UBound(zrr)
If zrr(i, 1) = "有数据" Then
s = zrr(i, 2)
d(s) = Array(zrr(i, 3), zrr(i, 4), zrr(i, 5))
End If
Next
For i = 1 To UBound(arr)
s = arr(i, 9)
If d.exists(s) Then
For j = 11 To 13
arr(i, j) = d(s)(j - 11)
Next
End If
Next
With Sheets("表2")
.[a3].Resize(UBound(arr), UBound(arr, 2)) = arr
End With
Set d = Nothing
MsgBox "OK！"
End Sub

复制代码

ykcbf1100 · 发表于 2023-12-17 14:04

本帖最后由 ykcbf1100 于 2023-12-17 14:30 编辑

附件供参考。。。

fgq5910 · 发表于 2023-12-17 14:13

ykcbf1100 发表于 2023-12-17 14:04
附件供参考。。。

非常感谢！
能否加个条件
F栏（授课教师栏）里为空，不填充
如：F5里没有教师姓名，就不填充

ykcbf1100 · 发表于 2023-12-17 14:31

fgq5910 发表于 2023-12-17 14:13
非常感谢！
能否加个条件
F栏（授课教师栏）里为空，不填充

修改好了。。。

fgq5910 · 发表于 2023-12-17 14:35

ykcbf1100 发表于 2023-12-17 14:31
修改好了。。。

谢谢！
正是我想要的结果

yynrzwh · 发表于 2023-12-17 14:36

用VBA根据条件自动填充2.rar (23.76 KB, 下载次数: 21)

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

[已解决] 用VBA根据条件自动填充

评分

评分

评分

评分