excel 日报表求助

zyf7527721

老师威武，两个我都试了下，完美达到了效果，和我的两个思路完全一致，术业有专攻，还得多向各位老师各位大神学习。

ykcbf1100

代码已写，因工作表保护，无法放上按钮，你自己搞一下吧。
注：表2日期格式要改成与录入表一致才行。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.7.18
   
2.     b = [{6,12}]
   
3.     With Sheets("0数据录入")
   
4.         rq = .[s6]
   
5.         arr = .[s1:y100]
   
6.     End With
   
7.     With Sheets("2水量表格统计")
   
8.         r = 34
   
9.         For i = 4 To r
   
10.             If .Cells(i, 1) = rq Then
    
11.                 For j = 2 To 7
    
12.                     .Cells(i, j) = arr(b(1), j)
    
13.                 Next
    
14.             End If
    
15.         Next
    
16.     End With
    
17.     With Sheets("4电量统计")
    
18.         r = 35
    
19.         For i = 5 To r
    
20.             If .Cells(i, 1) = rq Then
    
21.                 For j = 2 To 6
    
22.                     .Cells(i, j) = arr(b(2), j)
    
23.                 Next
    
24.             End If
    
25.         Next
    
26.     End With
    
27.     MsgBox "OK！"
    
28. End Sub
    

复制代码

zyf7527721

铁马1980 发表于 2024-7-18 12:40
test2你需要把两个表的日期格式统一了才行

多次试用后，test1可以连续使用，但S6：Y6里面如果是公式会报错；test2使用时S6：Y6里面如果是公式会报错。

zyf7527721

ykcbf1100 发表于 2024-7-18 14:38
参与一下。。。

谢谢老师！执行后文本框“OK"出现，数据实际上没有写入。

ykcbf1100

zyf7527721 发表于 2024-7-18 15:23
谢谢老师！执行后文本框“OK"出现，数据实际上没有写入。

我改一下吧，适应你二个表日期格式不同的情况。

dy83797465268

1. Option Explicit
   
2. Sub copyData()
   
3. 
   
4. If Cells(Range("A4").CurrentRegion.Rows.Count, 1) = "µ±ÔºϼÆ" Then Rows(Range("A4").CurrentRegion.Rows.Count).Delete
   
5. 
   
6.     Sheets("0Êý¾Ý¼Èë").Range("S6:Y6").Copy
   
7.     Sheets("2Ë®Á¿±í¸ñͳ¼Æ").Cells(1000, 1).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
   
8.     Sheets("2Ë®Á¿±í¸ñͳ¼Æ").Cells(1000, 1).End(xlUp).Offset(1, 0) = "µ±ÔºϼÆ"
   
9.     Sheets("2Ë®Á¿±í¸ñͳ¼Æ").Cells(1000, 1).End(xlUp).Offset(0, 1) = Application.WorksheetFunction.Sum(Sheets("2Ë®Á¿±í¸ñͳ¼Æ").Range("B4:B" & Range("A4").CurrentRegion.Rows.Count - 1))
   
10.     Sheets("2Ë®Á¿±í¸ñͳ¼Æ").Cells(1000, 1).End(xlUp).Offset(0, 2) = Application.WorksheetFunction.Sum(Sheets("2Ë®Á¿±í¸ñͳ¼Æ").Range("C4:C" & Range("A4").CurrentRegion.Rows.Count - 1))
    
11. End Sub
    
12. 
    

复制代码

dy83797465268

直接复制黏贴了，并计算合计。。
我上传的附件和代码怎么那么慢。。。。。。。。

ykcbf1100

我把日期先转换成标准的日期格式再查找日期的位置。

1. Sub ykcbf()  '//2024.7.18
   
2.     b = [{6,12}]
   
3.     With Sheets("0数据录入")
   
4.         rq = CDate(Replace(.[s6], ".", "/"))
   
5.         arr = .[s1:y100]
   
6.     End With
   
7.     With Sheets("2水量表格统计")
   
8.         r = 34
   
9.         For i = 4 To r
   
10.             If CDate(Replace(.Cells(i, 1), ".", "/")) = rq Then
    
11.                 For j = 2 To 7
    
12.                     .Cells(i, j) = arr(b(1), j)
    
13.                 Next
    
14.             End If
    
15.         Next
    
16.     End With
    
17.     With Sheets("4电量统计")
    
18.         r = 35
    
19.         For i = 5 To r
    
20.             If CDate(Replace(.Cells(i, 1), ".", "/")) = rq Then
    
21.                 For j = 2 To 6
    
22.                     .Cells(i, j) = arr(b(2), j)
    
23.                 Next
    
24.             End If
    
25.         Next
    
26.     End With
    
27.     MsgBox "OK！"
    
28. End Sub
    

复制代码

ytmpgght

ykcbf1100 发表于 2024-7-18 15:35
我改一下吧，适应你二个表日期格式不同的情况。

我有一个问题好奇问下ykcbf老师：b = [{6,12}] 和b = Array("6", "12") 是不是同一个作用，只是用你的方法使得索引号从1开始，而不像array生成的是从0开始索引的？！