求助VBA大神：当一列值相同，求对应另一列的最大值

Hontyu

..............

Hontyu

马上2023年了,楼主注册这么多年,应该要学会一项新技巧了,请速速点下右下角的评分

Curry_Chen

Hontyu 发表于 2022-12-30 11:49
马上2023年了,楼主注册这么多年,应该要学会一项新技巧了,请速速点下右下角的评分

感谢Hontyu大佬！！！这个论坛是注册很多年了，中间没怎么上过，VBA也学过多次，总是从开始到放弃，没啥思路

笨鸟飞不高

求最大值.zip (21.12 KB, 下载次数: 4)

2022-12-30 12:41 上传

点击文件名下载附件

pc087

Excel365功能--ExcelScript

Curry_Chen

pc087 发表于 2022-12-30 15:14
Excel365功能--ExcelScript

可以把完整的代码贴下么？

pc087

1. function main(wb: ExcelScript.Workbook) {
   
2.     // Your code here
   
3.     const sht: ExcelScript.Worksheet = wb.getActiveWorksheet()
   
4.     const objs = sht.getRange("a7").getSurroundingRegion().getTexts().reduce((s,row)=>{
   
5.       let kw = row[1]
   
6.       let arr :(string|number)[] = s[kw] || row
   
7.       arr = Number(row[2]) >= Number(arr[2]) ? row:arr
   
8.       return s[kw] = arr,s
   
9.     },{})
   
10.     const arr :string[][] = Object.values(objs)
    
11.     sht.getRange("E1").getAbsoluteResizedRange(arr.length,3).setValues(arr)
    
12. }

复制代码

Curry_Chen

pc087 发表于 2022-12-30 21:41

我的是excel2019的，好像用不了

small_small

1. Sub test()
   
2.     Dim arr, brr(), d, k As Integer, m As Integer, n As Integer
   
3.     arr = Range("a7").CurrentRegion.Value
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     ReDim Preserve brr(1 To 1000, 1 To UBound(arr, 2))
   
6.     For k = 2 To UBound(arr) - 1
   
7.         If Not d.exists(arr(k, 2)) Then
   
8.             n = n + 1
   
9.             d(arr(k, 2)) = n
   
10.             brr(n, 1) = arr(k, 1)
    
11.             brr(n, 2) = arr(k, 2)
    
12.             brr(n, 3) = arr(k, 3)
    
13.         Else
    
14.             m = d(arr(k, 2))
    
15.             If (arr(k, 3)) >= brr(m, 3) Then brr(m, 1) = arr(k, 1): brr(m, 3) = arr(k, 3)
    
16.         End If
    
17.     Next k
    
18.     Columns(6).NumberFormatLocal = "@"
    
19.     Range("f8").Resize(n, 3) = brr
    
20. End Sub
    

复制代码