2个表格中的数据互相使用

huizhuzi

需求如下：
1、双击Q1运行代码
2、签到表根据学员有效数据（序号、姓名）赋值到签到表对应的位置（因不是一直排下去，所以已在签到表设置好相应序号位置，每30行就换列）
3、数据赋值时，因数据是变量，能否从A3开始设定行高，能否都设置好表格？
4、因在签到表出成绩，所以签到表的成绩能不能对应赋值回学员表中相应的位置？
（签到表模板）.rar (12.53 KB, 下载次数: 7)

2018-6-16 19:51 上传

点击文件名下载附件

求指教

huizhuzi

有大神会吗？求指教

huizhuzi

有大神会吗？求指教

不知道为什么

huizhuzi 发表于 2018-6-17 13:49
有大神会吗？求指教

你这个不是什么问题，自己的附件上了2张无数据的sheet，具体的需求又说不明白，别人怎么帮你，不是浪费时间？

ruoyunruyan

1. Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
   
2. If Target.Address = "$Q$1" Then Call QDB
   
3. End Sub
   
4. Sub QDB()
   
5. Dim i%, j%, k%
   
6. k = 3
   
7. With Sheet2
   
8. j = .[c65536].End(3).Row
   
9. For i = 1 To j
   
10. If Int((i - 1) / 30) Mod 2 Then
    
11. i = i + 29
    
12. Else
    
13. Cells(k, 1) = i
    
14. Cells(k, 2) = .Cells(i + 3, 2)
    
15. Cells(k, 3) = .Cells(i + 3, 3)
    
16. Cells(k, 6) = i + 30
    
17. Cells(k, 7) = .Cells(i + 33, 2)
    
18. Cells(k, 8) = .Cells(i + 33, 3)
    
19. k = k + 1
    
20. End If
    
21. Next
    
22. End With
    
23. End Sub
    

复制代码

huizhuzi

不知道为什么 发表于 2018-6-17 13:56
你这个不是什么问题，自己的附件上了2张无数据的sheet，具体的需求又说不明白，别人怎么帮你，不是浪费时 ...

不好意思，表述不是很清楚

huizhuzi

ruoyunruyan 发表于 2018-6-17 15:54

谢谢！数据赋值时，数据能否从A3开始设定行高，数据都设置好表格？

zjdh

还真看不懂你的描述！！

ruoyunruyan

1. Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
   
2. If Target.Address = "$Q$1" Then Call QDB
   
3. End Sub
   
4. Sub QDB()
   
5. Dim i%, j%, k%
   
6. k = 3
   
7. With Sheet2
   
8. j = .[c65536].End(3).Row
   
9. For i = 1 To j
   
10. If Int((i - 1) / 30) Mod 2 Then
    
11. i = i + 29
    
12. Else
    
13. Cells(k, 1) = i
    
14. Cells(k, 2) = .Cells(i + 3, 2)
    
15. Cells(k, 3) = .Cells(i + 3, 3)
    
16. Cells(k, 6) = i + 30
    
17. Cells(k, 7) = .Cells(i + 33, 2)
    
18. Cells(k, 8) = .Cells(i + 33, 3)
    
19. k = k + 1
    
20. End If
    
21. Next
    
22. End With
    
23. With Range("a3").CurrentRegion
    
24. .RowHeight = 20             '设置行高
    
25. .Borders.LineStyle = xlContinuous    '边框
    
26. .Offset(0, 5).Borders.LineStyle = xlContinuous
    
27. End With
    
28. End Sub
    

复制代码

huizhuzi

zjdh 发表于 2018-6-17 20:53
还真看不懂你的描述！！

口才不好！！！