求助大神，从近20日最高、最低销售工作表中取出最高值及对应日期，最低值及对应日期

wangchcm

求助大神，从近20日最高、最低销售工作表中取出最高值及对应日期，最低值及对应日期，三个工作表中的存货编码是一样的，顺序也是一样的，感谢大神出手相助！！！

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.11.6
   
2.     Application.ScreenUpdating = False
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     Set d1 = CreateObject("Scripting.Dictionary")
   
5.     arr = Sheets("每日最高(公)").UsedRange
   
6.     For i = 2 To UBound(arr)
   
7.         s = arr(i, 2)
   
8.         For j = 25 To UBound(arr, 2)
   
9.             If Not d.exists(s) Then
   
10.                 d(s) = Array(arr(i, j), arr(1, j))
    
11.             Else
    
12.                 t = d(s)
    
13.                 t(0) = IIf(t(0) > arr(i, j), t(0), arr(i, j))
    
14.                 t(1) = IIf(t(0) > arr(i, j), t(1), arr(1, j))
    
15.                 d(s) = t
    
16.             End If
    
17.         Next
    
18.     Next
    
19.     arr = Sheets("每日最低（公）").UsedRange
    
20.     For i = 2 To UBound(arr)
    
21.         s = arr(i, 2)
    
22.         For j = 27 To UBound(arr, 2)
    
23.             If Not d1.exists(s) Then
    
24.                 d1(s) = Array(arr(i, j), arr(1, j))
    
25.             Else
    
26.                 t = d1(s)
    
27.                 t(0) = IIf(t(0) < arr(i, j), t(0), arr(i, j))
    
28.                 t(1) = IIf(t(0) < arr(i, j), t(1), arr(1, j))
    
29.                 d1(s) = t
    
30.             End If
    
31.         Next
    
32.     Next
    
33.     With Sheets("1判每日取数判断（公）")
    
34.         r = .Cells(Rows.Count, 1).End(3).Row
    
35.         arr = .[a1].Resize(r, 14)
    
36.         For i = 2 To UBound(arr)
    
37.             s = arr(i, 2)
    
38.             If d.exists(s) Then
    
39.                 arr(i, 11) = d(s)(0)
    
40.                 arr(i, 12) = d(s)(1)
    
41.                 arr(i, 13) = d1(s)(0)
    
42.                 arr(i, 14) = d1(s)(1)
    
43.             End If
    
44.         Next
    
45.         .[a1].Resize(r, 14) = arr
    
46.     End With
    
47.     Set d = Nothing
    
48.     Application.ScreenUpdating = True
    
49.     MsgBox "OK！"
    
50. End Sub
    
51. 
    

复制代码

chxw68

参与一下。

z865593849

取最值

ykcbf1100

代码简化一下。

ykcbf1100

简化一下。。。

wangchcm

ykcbf1100 发表于 2024-11-7 14:50
代码简化一下。

非常感谢大神！现在有个需求，即，编码中带了一个'符号，取数后，这个'符号就不见了，想保留住这个'符号的编码格式，请大神再次出手相助！！！不胜感激！！！

ykcbf1100

wangchcm 发表于 2024-11-8 14:59
非常感谢大神！现在有个需求，即，编码中带了一个'符号，取数后，这个'符号就不见了，想保留住这个'符号 ...

附件超过2M无法上传，就上个图片吧。

就加一句代码就行。

wangchcm

ykcbf1100 发表于 2024-11-8 15:16
附件超过2M无法上传，就上个图片吧。

就加一句代码就行。

收到再次感谢大神！现在请再帮看看，我是哪设的不对，最低值取不上了，感谢！！！！！