[已解决]vba自动添加学校年级

武林长风

在不改动工作表的前提下，若c列有学生的姓名，则在L列自动添加他所在的学校年级，在M列自动添加他的班主任姓名；若c列没有学生的姓名则L、M均为空。不要在L、M用公式引用，我想要的是自动查找他所在的学校、班级，然后合在一起自动添加。可否添加个按钮，一点就自动添加。 自动添加.rar (39.11 KB, 下载次数: 12)

2014-7-16 00:34 上传

点击文件名下载附件 下面的第726行开始出错。

最佳答案

月排行榜 / 总排行榜

dsmch

2014-7-16 05:11

………………

跳转到最佳答案楼层

dsmch

1. Sub Macro1()
   
2. Dim arr, brr, i&, x&
   
3. arr = Range("a1:f" & [a65536].End(xlUp).Row)
   
4. ReDim brr(1 To UBound(arr), 1 To 2)
   
5. For i = 1 To UBound(arr)
   
6.     If arr(i, 3) = "班主任：" Then x = i
   
7.     If IsNumeric(arr(i, 4)) And arr(i, 4) <> "" And i > x Then
   
8.         brr(i, 1) = arr(i, 2) & arr(x, 1): brr(i, 2) = arr(x, 4)
   
9.     End If
   
10. Next
    
11. [l:m].ClearContents
    
12. [l1].Resize(UBound(brr), 2) = brr
    
13. End Sub

复制代码

dsmch

………………

baksy

更新到5楼

baksy

函数解决2：
L3=IF((C3<>"")*(C3<>"姓 名")*(C3<>"班主任："),B3&OFFSET(A3,-(A3+1),),"")
M3=IF(L3<>"",OFFSET(IF(ROW()<726,D3,G3),-(A3+1),),"")
公式下拉。

武林长风

dsmch 发表于 2014-7-16 05:11
………………

检测后726行开始出错，请修改，谢谢。

武林长风

baksy 发表于 2014-7-16 09:34
函数解决2：
L3=IF((C3"")*(C3"姓 名")*(C3"班主任："),B3&OFFSET(A3,-(A3+1),),"")
M3=IF(L3"",OFFSET(I ...

函数不太方便，请您再做个VBA的吧。

dsmch

武林长风 发表于 2014-7-16 10:41
检测后726行开始出错，请修改，谢谢。

1. Sub Macro1()
   
2. Dim arr, brr, i&, x&, j%
   
3. arr = Range("a1:k" & [a65536].End(xlUp).Row)
   
4. ReDim brr(1 To UBound(arr), 1 To 2)
   
5. For i = 1 To UBound(arr)
   
6. For j = 3 To 6 Step 3
   
7. If arr(i, j) = "班主任：" Then x = i: y = j
   
8. Next
   
9. If IsNumeric(arr(i, 4)) And arr(i, 4) <> "" And i > x Then
   
10. brr(i, 1) = arr(i, 2) & arr(x, 1): brr(i, 2) = arr(x, y + 1)
    
11. End If
    
12. Next
    
13. [l:m].ClearContents
    
14. [l1].Resize(UBound(brr), 2) = brr
    
15. End Sub

复制代码