Excel精英培训网

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

[已解决]能否用VBA代码来代替我的公式呢?

[复制链接]
发表于 2015-10-11 18:06 | 显示全部楼层 |阅读模式
工作簿1.zip (8.39 KB, 下载次数: 24)
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2015-10-11 18:45 | 显示全部楼层
  1. Sub 宏1()
  2.     Dim x, arr
  3.     arr = Range("e4:e" & Range("a65536").End(3).Row)

  4.     For x = 1 To UBound(arr)
  5.         Cells(x + 3, "e").FormulaR1C1 = _
  6.         "=IF(COUNTIFS(R4C1:RC[-4],RC[-4],R4C4:RC[-1],RC[-1])=1,""第一条记录"","""")"
  7.     Next

  8. End Sub
复制代码
试试行不行

工作簿1.rar

16.15 KB, 下载次数: 5

回复

使用道具 举报

 楼主| 发表于 2015-10-11 19:37 | 显示全部楼层
tzjx200521 发表于 2015-10-11 18:45
试试行不行

我的真实数据不止65536行,有10万多行
回复

使用道具 举报

发表于 2015-10-11 22:27 | 显示全部楼层
  1. Sub 宏1()
  2.     Dim x, arr
  3.     arr = Range("e4:e" & Range("a1048576").End(3).Row)

  4.     For x = 1 To UBound(arr)
  5.         Cells(x + 3, "e").FormulaR1C1 = _
  6.         "=IF(COUNTIFS(R4C1:RC[-4],RC[-4],R4C4:RC[-1],RC[-1])=1,""第一条记录"","""")"
  7.     Next

  8. End Sub
复制代码
多大都行

工作簿1.rar

16.27 KB, 下载次数: 9

回复

使用道具 举报

 楼主| 发表于 2015-10-12 14:16 | 显示全部楼层
本帖最后由 qinqin1122 于 2015-10-12 14:23 编辑
tzjx200521 发表于 2015-10-11 22:27
多大都行

不行,原来还是用函数,这样就没有意义了。且这么大数据量,函数跑不动的。因为数据多才不能用函数的。

我的意思是用vBA代码得到函数那样的结果。

这里附件只能上传500KB,没办法上传我的的实际附件
回复

使用道具 举报

发表于 2015-10-13 10:47 | 显示全部楼层    本楼为最佳答案   
  1. Sub tt()
  2.     arr = Range("a4:d" & Cells(Rows.Count, 1).End(3).Row)
  3.     Set d = CreateObject("scripting.dictionary")
  4.     ReDim brr(1 To UBound(arr), 1 To 2)
  5.     For i = 1 To UBound(arr)
  6.         x = arr(i, 1) & arr(i, 4) 'key 为名称+城市
  7.         If Not d.exists(x) Then
  8.             brr(i, 1) = "第一条记录"
  9.             brr(i, 2) = 1
  10.             d(x) = ""
  11.         End If
  12.     Next
  13.     [H4].Resize(UBound(brr), 2) = brr
  14. End Sub
复制代码
回复

使用道具 举报

发表于 2015-10-13 10:48 | 显示全部楼层
请看附件。

工作簿1.rar

17.22 KB, 下载次数: 10

评分

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

查看全部评分

回复

使用道具 举报

 楼主| 发表于 2015-10-13 20:14 | 显示全部楼层
grf1973 发表于 2015-10-13 10:48
请看附件。

你好,非常感谢!为什么我用了你的代码修改了下单元格地址用到实际数据中就不行呢?是不是我还有哪里没改?麻烦高手帮我看看。谢谢。
因为文件超过了,只好分卷压缩了,不知道能不能看到?

第一条记录.part1.rar (500 KB, 下载次数: 2)
回复

使用道具 举报

发表于 2015-10-14 08:59 | 显示全部楼层
Sub tt()
    arr = Range("N2:s" & Cells(Rows.Count, "N").End(3).Row)
    Set d = CreateObject("scripting.dictionary")
    ReDim brr(1 To UBound(arr), 1 To 1)
    For i = 1 To UBound(arr)
        x = arr(i, 1) & arr(i, 6) 'key 为名称+城市
        If Not d.exists(x) Then
            brr(i, 1) = 1
            d(x) = ""
        End If
    Next
    [ad2].Resize(UBound(brr), 1) = brr
End Sub

评分

参与人数 1 +1 收起 理由
qinqin1122 + 1 赞一个<span id="transmark">

查看全部评分

回复

使用道具 举报

发表于 2015-10-14 08:59 | 显示全部楼层
你的新表中定义源数据的数组范围出错了。
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-29 08:32 , Processed in 0.815516 second(s), 16 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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