Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 2752|回复: 2

[已解决]代码怎么写?

[复制链接]
发表于 2015-11-25 10:37 | 显示全部楼层 |阅读模式
本帖最后由 hahada 于 2015-11-28 16:40 编辑

根据主关键字对应的型号A 型号B 型号C求出最大值


最佳答案
2015-11-25 18:20
  1. Sub Macro1()
  2. Dim arr, brr, d, i&, j%, s&
  3. Set d = CreateObject("scripting.dictionary")
  4. arr = [c4:g16]
  5. ReDim brr(1 To UBound(arr), 1 To (UBound(arr, 2) - 2) * 2 + 1)
  6. For i = 2 To UBound(arr)
  7.     If Not d.exists(arr(i, 1)) Then
  8.         s = s + 1
  9.         brr(s, 1) = arr(i, 1)
  10.         d(arr(i, 1)) = s
  11.         For j = 3 To UBound(arr, 2)
  12.             brr(s, (j - 2) * 2) = arr(i, j)
  13.             brr(s, (j - 2) * 2 + 1) = arr(i, j)
  14.         Next
  15.     Else
  16.         n = d(arr(i, 1))
  17.         For j = 3 To UBound(arr, 2)
  18.             If arr(i, j) > brr(n, (j - 2) * 2) Then brr(n, (j - 2) * 2) = arr(i, j)
  19.             If arr(i, j) < brr(n, (j - 2) * 2 + 1) Then brr(n, (j - 2) * 2 + 1) = arr(i, j)
  20.         Next
  21.     End If
  22. Next
  23. Range("h5").Resize(UBound(brr), UBound(brr, 2)) = brr
  24. End Sub
复制代码
发表于 2015-11-25 10:57 | 显示全部楼层
回复

使用道具 举报

发表于 2015-11-25 18:20 | 显示全部楼层    本楼为最佳答案   
  1. Sub Macro1()
  2. Dim arr, brr, d, i&, j%, s&
  3. Set d = CreateObject("scripting.dictionary")
  4. arr = [c4:g16]
  5. ReDim brr(1 To UBound(arr), 1 To (UBound(arr, 2) - 2) * 2 + 1)
  6. For i = 2 To UBound(arr)
  7.     If Not d.exists(arr(i, 1)) Then
  8.         s = s + 1
  9.         brr(s, 1) = arr(i, 1)
  10.         d(arr(i, 1)) = s
  11.         For j = 3 To UBound(arr, 2)
  12.             brr(s, (j - 2) * 2) = arr(i, j)
  13.             brr(s, (j - 2) * 2 + 1) = arr(i, j)
  14.         Next
  15.     Else
  16.         n = d(arr(i, 1))
  17.         For j = 3 To UBound(arr, 2)
  18.             If arr(i, j) > brr(n, (j - 2) * 2) Then brr(n, (j - 2) * 2) = arr(i, j)
  19.             If arr(i, j) < brr(n, (j - 2) * 2 + 1) Then brr(n, (j - 2) * 2 + 1) = arr(i, j)
  20.         Next
  21.     End If
  22. Next
  23. Range("h5").Resize(UBound(brr), UBound(brr, 2)) = brr
  24. End Sub
复制代码

评分

参与人数 1 +3 收起 理由
hahada + 3 很给力!

查看全部评分

回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 09:16 , Processed in 0.498093 second(s), 14 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表