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

ykcbf1100

wangchcm 发表于 2024-11-8 16:31
收到再次感谢大神！现在请再帮看看，我是哪设的不对，最低值取不上了，感谢！！！！！

代码存放的位置不要随意改变。

分表中，日期开始列的位置不要随意改变，如果要改变，代码要修改相应列号。

wangchcm

ykcbf1100 发表于 2024-11-8 17:47
代码存放的位置不要随意改变。

分表中，日期开始列的位置不要随意改变，如果要改变，代码要修改相应列 ...

非常感谢！！！好用！！！厉害！！！最后再求助一次大神，从“每日最强”工作表中自AA列，每行由左到右，第一个1数字对应的日期（即取最近日期）填写到O列，感恩大神的无私帮助！！！添麻烦了！！！

ykcbf1100

wangchcm 发表于 2024-11-8 22:09
非常感谢！！！好用！！！厉害！！！最后再求助一次大神，从“每日最强”工作表中自AA列，每行由左到右， ...

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf2()  '//2024.11.9
   
2.     Application.ScreenUpdating = False
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     With Sheets("每日最强")
   
5.         r = .Cells(Rows.Count, 2).End(3).Row
   
6.         c = .Cells(1, Columns.Count).End(1).Column
   
7.         arr = .[a1].Resize(r, c)
   
8.     End With
   
9.     For i = 2 To UBound(arr)
   
10.         s = CStr(arr(i, 2))
    
11.         For j = 27 To UBound(arr, 2)   '//日期超始列号
    
12.             If arr(i, j) <> Empty Then
    
13.                 rq = arr(1, j)
    
14.                 Exit For
    
15.             Else
    
16.                 rq = ""
    
17.             End If
    
18.         Next
    
19.         d(s) = rq
    
20.     Next
    
21.     With Sheets("1判每日取数判断（公）")
    
22.         r = .Cells(Rows.Count, 1).End(3).Row
    
23.         arr = .[a1].Resize(r, 15)
    
24.         For i = 2 To UBound(arr)
    
25.             s = CStr(arr(i, 2))
    
26.             If d.exists(s) Then
    
27.                 arr(i, 15) = d(s)
    
28.             End If
    
29.         Next
    
30.         .[o1].Resize(r, 1) = Application.Index(arr, 0, 15)
    
31.     End With
    
32.     Set d = Nothing
    
33.     Application.ScreenUpdating = True
    
34.     MsgBox "OK！"
    
35. End Sub
    

复制代码

wangchcm

ykcbf1100 发表于 2024-11-9 07:18
附件供参考。。。

非常感谢大神！！！ 日期取得非常正确！！！都不太好意思了！我想自行改一下能取上对应值，自身水平不行，还得麻烦大神出手帮将对应的值取上，感谢感谢！！！

ykcbf1100

wangchcm 发表于 2024-11-10 21:16
非常感谢大神！！！日期取得非常正确！！！都不太好意思了！我想自行改一下能取上对应值，自身水平不行， ...

提取一个数和提取多个数的写法不一样的。

ykcbf1100

改一下。。。

1. Sub ykcbf2()  '//2024.11.11
   
2.     Application.ScreenUpdating = False
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     With Sheets("每日最强")
   
5.         r = .Cells(Rows.Count, 2).End(3).Row
   
6.         c = .Cells(1, Columns.Count).End(1).Column
   
7.         arr = .[a1].Resize(r, c)
   
8.     End With
   
9.     For i = 2 To UBound(arr)
   
10.         s = CStr(arr(i, 2))
    
11.         For j = 27 To UBound(arr, 2)   '//日期超始列号
    
12.             If arr(i, j) <> Empty Then
    
13.                 d(s) = Array(arr(1, j), arr(i, j))
    
14.                 Exit For
    
15.             End If
    
16.         Next
    
17.     Next
    
18.     On Error Resume Next
    
19.     With Sheets("1判每日取数判断（公）")
    
20.         r = .Cells(Rows.Count, 1).End(3).Row
    
21.         arr = .[a1].Resize(r, 16)
    
22.         For i = 2 To UBound(arr)
    
23.             s = CStr(arr(i, 2))
    
24.             If d.exists(s) Then
    
25.                 arr(i, 15) = d(s)(0)
    
26.                 arr(i, 16) = d(s)(1)
    
27.             End If
    
28.         Next
    
29.         .Columns(2).NumberFormatLocal = "@"
    
30.         .[a1].Resize(r, 16) = arr
    
31.     End With
    
32.     Set d = Nothing
    
33.     Application.ScreenUpdating = True
    
34.     MsgBox "OK！"
    
35. End Sub
    

复制代码

wangchcm

ykcbf1100 发表于 2024-11-11 06:54
提取一个数和提取多个数的写法不一样的。

感谢大神！！！取数正确，现在加了一个合计列，一取数，合计列的公式就变成数值了，公式就取消了 ，还要请大神帮忙如何能取上数，加的合计公式保留原格式，或只取相应值，表中带的公式不取消，感谢！感谢！！！

ykcbf1100

直接用代码生成合计好了。

ykcbf1100

合计也写进去。

1. Sub ykcbf2()  '//2024.11.11
   
2.     Application.ScreenUpdating = False
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     With Sheets("每日最强")
   
5.         r = .Cells(Rows.Count, 2).End(3).Row
   
6.         c = .Cells(1, Columns.Count).End(1).Column
   
7.         arr = .[a1].Resize(r, c)
   
8.         For i = 2 To UBound(arr)
   
9.             s = CStr(arr(i, 2))
   
10.             Sum = Application.Sum(.Cells(i, 27).Resize(, c - 26))
    
11.             For j = 27 To UBound(arr, 2)   '//日期超始列号
    
12.                 If arr(i, j) <> Empty Then
    
13.                     d(s) = Array(Sum, arr(1, j), arr(i, j))
    
14.                     Exit For
    
15.                 End If
    
16.             Next
    
17.         Next
    
18.     End With
    
19.     On Error Resume Next
    
20.     With Sheets("1判每日取数判断（公）")
    
21.         r = .Cells(Rows.Count, 1).End(3).Row
    
22.         arr = .[a1].Resize(r, 19)
    
23.         For i = 2 To UBound(arr)
    
24.             s = CStr(arr(i, 2))
    
25.             If d.exists(s) Then
    
26.                 arr(i, 16) = d(s)(0)
    
27.                 arr(i, 18) = d(s)(1)
    
28.                 arr(i, 19) = d(s)(2)
    
29.             End If
    
30.         Next
    
31.         .Columns(2).NumberFormatLocal = "@"
    
32.         .[a1].Resize(r, 19) = arr
    
33.     End With
    
34.     Set d = Nothing
    
35.     Application.ScreenUpdating = True
    
36.     MsgBox "OK！"
    
37. End Sub
    
38. 
    

复制代码