如何用VBA统计和值

ykcbf1100

sampsonpon 发表于 2024-8-30 10:32
老师，完全一个类似的东西，套您的代码还是不能得到结果，能给看看吗

其它先不说，这句就错了：xlsPath = ThisWorkbook.Path & "\Auto_LIST.xlsb"
我看了代码，和我写的完全不是一个风格，改不了。

sampsonpon

ykcbf1100 发表于 2024-8-30 12:06
其它先不说，这句就错了：xlsPath = ThisWorkbook.Path & "\Auto_LIST.xlsb"
我看了代码，和我写的完全 ...

老师老师，您看错了！最底下啦就是您的代码！

1. Sub Other_Hour()
   
2.    
   
3.     Application.ScreenUpdating = False
   
4.    
   
5.     Set d = CreateObject("Scripting.Dictionary")
   
6.     p = ThisWorkbook.Path & ""
   
7.     Set sh = ThisWorkbook.Sheets("Individual")
   
8.     f = p & "其他时间*.xlsx"
   
9.     Set wb = Workbooks.Open(f, 0)
   
10.     With wb.Sheets("Sheet1")
    
11.         r = .Cells(Rows.Count, 1).End(3).Row
    
12.         arr = .[a1].Resize(r, 23)
    
13.     End With
    
14.     wb.Close 0
    
15.     For i = 2 To UBound(arr)
    
16. '        If arr(i, 4) = "RX WH" Then
    
17.             s = CStr(arr(i, 2)) & "|" & CDate(arr(i, 7))
    
18.             d(s) = d(s) + 0 ' + Val(arr(i, 4))
    
19. '        End If
    
20.     Next
    
21.     With sh
    
22.         r = .Cells(Rows.Count, 2).End(3).Row
    
23.         For i = 232 To r
    
24.             For j = 216 To 246
    
25.                 s = CStr(.Cells(i, 2).Value) & "|" & CDate(.Cells(231, j).Value)
    
26.                 If d.exists(s) Then
    
27.                     .Cells(i, j).Value = d(s)
    
28.                 End If
    
29.             Next
    
30.         Next
    
31.         ActiveWindow.DisplayZeros = False
    
32.     End With
    
33.     Set d = Nothing
    
34.    
    
35.     Application.ScreenUpdating = True
    
36. '    MsgBox "OK！"
    
37. End Sub

复制代码

sampsonpon

ykcbf1100 发表于 2024-8-30 12:06
其它先不说，这句就错了：xlsPath = ThisWorkbook.Path & "\Auto_LIST.xlsb"
我看了代码，和我写的完全 ...

老师，您看错了，在最底下，就是您的代码

ykcbf1100

sampsonpon 发表于 2024-8-30 13:43
老师，您看错了，在最底下，就是您的代码

可以了。

G列的日期格式与原来的不一样，所以，要先处理一下。

ykcbf1100

关键代码修改

ykcbf1100

全部代码如下：

1. Sub Other_Hour()   '//2024.8.30
   
2.     Application.ScreenUpdating = False
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     p = ThisWorkbook.Path & ""
   
5.     Set sh = ThisWorkbook.Sheets("Individual")
   
6.     f = p & "其他时间_20240829163723.xlsx"
   
7.     Set wb = Workbooks.Open(f, 0)
   
8.     With wb.Sheets("Sheet1")
   
9.         r = .Cells(Rows.Count, 1).End(3).Row
   
10.         c = .Cells(1, "XFD").End(1).Column
    
11.         arr = .[a1].Resize(r, c)
    
12.     End With
    
13.     wb.Close 0
    
14.     For i = 2 To UBound(arr)
    
15.         rq = CDate(Split(arr(i, 7))(0))         '//日期格式先处理
    
16.         s = CStr(arr(i, 2)) & "|" & CDate(rq)
    
17.         d(s) = d(s) + Val(arr(i, 4))
    
18.     Next
    
19.     With sh
    
20.         r = .Cells(Rows.Count, 2).End(3).Row
    
21.         For i = 232 To r
    
22.             For j = 216 To 246
    
23.                 s = CStr(.Cells(i, 2).Value) & "|" & CDate(.Cells(231, j).Value)
    
24.                 If d.exists(s) Then
    
25.                     .Cells(i, j).Value = d(s)
    
26.                 Else
    
27.                     .Cells(i, j).Value = ""
    
28.                 End If
    
29.             Next
    
30.         Next
    
31.         ActiveWindow.DisplayZeros = False
    
32.     End With
    
33.     Set d = Nothing
    
34.     Application.ScreenUpdating = True
    
35.     '    MsgBox "OK！"
    
36. End Sub
    
37. 
    

复制代码

sampsonpon

ykcbf1100 发表于 2024-8-30 14:28
可以了。

G列的日期格式与原来的不一样，所以，要先处理一下。

如果它的文件名"其他时间_20240829163723"，后面的数字一直在变，_前面固定不变的，
那么这个地方应该怎么表达？"其他时间_*.xlsx"？

ykcbf1100

sampsonpon 发表于 2024-8-30 14:58
如果它的文件名"其他时间_20240829163723"，后面的数字一直在变，_前面固定不变的，
那么这个地方应 ...

那就改为文件自选吧。

sampsonpon

ykcbf1100 发表于 2024-8-30 14:30
全部代码如下：

把结果写到两个区域了：HH233:IL256  HH270:IL294
所以它就把我红圈这些公式和标题也都给删了，应该是行号取错了吧？

sampsonpon

ykcbf1100 发表于 2024-8-30 15:03
那就改为文件自选吧。

自选的不好不好