Excel精英培训网

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

[VBA] 用VBA将公式改写一下

[复制链接]
发表于 2016-10-2 22:05 | 显示全部楼层 |阅读模式
用VBA将公式改写一下

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?注册

x
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2016-10-2 23:28 | 显示全部楼层
  1. Sub cz()
  2.     Dim arr, i&, j&, d As Object, k, it, n&
  3.     arr = Sheets("sheet1").Range("b1:g" & [g65536].End(3).Row)
  4.     ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
  5.     Set d = CreateObject("scripting.dictionary")
  6.     For j = 1 To UBound(arr, 2)
  7.         For i = 1 To UBound(arr)
  8.             If Not d.exists(arr(i, j)) Then
  9.                 d(arr(i, j)) = ""
  10.             Else
  11.                 d(arr(i, j)) = i
  12.             End If
  13.         Next
  14.         k = d.keys: it = d.items
  15.         For n = 0 To d.Count - 1
  16.             If it(n) <> "" Then brr(it(n), j) = k(n)
  17.         Next
  18.         d.RemoveAll
  19.     Next
  20.     Sheets("sheet1").[p1].Resize(i - 1, j - 1).ClearContents
  21.     Sheets("sheet1").[p1].Resize(i - 1, j - 1) = brr
  22. End Sub
复制代码


评分

参与人数 1 +3 收起 理由
laoau138 + 3 来学习

查看全部评分

回复

使用道具 举报

 楼主| 发表于 2016-10-2 23:30 | 显示全部楼层
回复

使用道具 举报

发表于 2016-10-2 23:33 | 显示全部楼层
你想要什么样的效果?是每列但凡有重复的所有的重复数字都显示,比如有3个4 全都显示出来,还是只显示最后一个4?
回复

使用道具 举报

发表于 2016-10-2 23:38 | 显示全部楼层
本帖最后由 today0427 于 2016-10-2 23:40 编辑

你的公式做出来本来就是个然酱子  前后结果都不一样

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?注册

x

评分

参与人数 1 +3 收起 理由
laoau138 + 3

查看全部评分

回复

使用道具 举报

 楼主| 发表于 2016-10-3 08:40 | 显示全部楼层
today0427 发表于 2016-10-2 23:38
你的公式做出来本来就是个然酱子  前后结果都不一样



B:G列数据,按行比较重复数字,不是按列比较

第一行与第二行比较,有重复数字,结果写在第二行

第二行与第三行比较...........





回复

使用道具 举报

发表于 2016-10-3 09:52 | 显示全部楼层
laoau138 发表于 2016-10-3 08:40
B:G列数据,按行比较重复数字,不是按列比较

第一行与第二行比较,有重复数字,结果写在第二行

我没有理解你的意思没做对 你居然彬彬有礼给我解释,这点太难得了[em01] 给你点个赞[em17]  好!一会儿按你要求再做一次!
回复

使用道具 举报

发表于 2016-10-3 11:13 | 显示全部楼层
laoau138 发表于 2016-10-3 08:40
B:G列数据,按行比较重复数字,不是按列比较

第一行与第二行比较,有重复数字,结果写在第二行

这个更简单
  1. Sub bcf()
  2.     Dim arr, brr(), i&, j&, str$
  3.     arr = Sheets("sheet1").Range("b1:g" & [g65536].End(3).Row)
  4.     ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
  5.         For i = 2 To UBound(arr)
  6.             str = "," & Join(Application.Index(arr, i - 1), ",") & ","
  7.             For j = 1 To UBound(arr, 2)
  8.                 If InStr(str, "," & arr(i, j) & ",") Then brr(i, j) = arr(i, j)
  9.             Next
  10.         Next
  11.     Sheets("sheet1").[p1].Resize(i - 1, j - 1).ClearContents
  12.     Sheets("sheet1").[p1].Resize(i - 1, j - 1) = brr
  13. End Sub
复制代码




本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?注册

x

评分

参与人数 1 +3 收起 理由
laoau138 + 3 来学习

查看全部评分

回复

使用道具 举报

 楼主| 发表于 2016-10-3 12:18 | 显示全部楼层
today0427 发表于 2016-10-3 09:52
我没有理解你的意思没做对 你居然彬彬有礼给我解释,这点太难得了 给你点个赞  好!一会儿按 ...

可能我写错,所以你会误解了

评分

参与人数 1 +6 收起 理由
today0427 + 6 这才是乖孩子!

查看全部评分

回复

使用道具 举报

 楼主| 发表于 2016-10-3 12:21 | 显示全部楼层
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-28 18:01 , Processed in 1.672169 second(s), 7 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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