Excel精英培训网

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

[已解决]使用vba完成需要的填充公式效果。

[复制链接]
发表于 2017-6-1 10:56 | 显示全部楼层 |阅读模式
2017-06-01_104502.png
如图,店铺销售明细情况表,A至C列分别是商店名称 商品代码 销售数量。D列是辅助列,D2单元格公式是=IF(COUNTIFS($B$2:B2,B2)=1,1,0),然后往下填充公式。它是获取B列商品代码的个数,有的就计算为1,重复的就不再计算,为0.  由于需要处理的数据行数很多,所以使用公式填充时比较费时,请问能否用VBA实现这种效果。谢谢,大神,请查看附件! 附件.rar (6.76 KB, 下载次数: 13)
发表于 2017-6-1 11:21 | 显示全部楼层    本楼为最佳答案   
试试!{:1312:}
  1. Sub test()
  2.     Dim d As Object
  3.     Dim ar, br()
  4.     Dim i As Long
  5.     Set d = CreateObject("scripting.dictionary")
  6.     ar = Cells(1, 1).CurrentRegion
  7.     ReDim br(1 To UBound(ar), 1 To 1)
  8.     br(1, 1) = "辅助列"
  9.     For i = 2 To UBound(ar)
  10.         If d.exists(ar(i, 2)) Then
  11.             br(i, 1) = 0
  12.         Else
  13.             d.Add ar(i, 2), ""
  14.             br(i, 1) = 1
  15.         End If
  16.     Next i
  17.     With Cells(1, 4)
  18.         .Resize(Rows.Count).ClearContents
  19.         .Resize(i - 1) = br
  20.     End With
  21. End Sub
复制代码


回复

使用道具 举报

发表于 2017-6-1 11:28 | 显示全部楼层
Sub qcw()
Dim r, i, rng
r = Range("a65536").End(xlUp).Row
For i = 2 To r
Set rng = Range("B1:B" & i - 1).Find(Cells(i, 2), LookIn:=xlValues, SearchDirection:=xlPrevious)
If Not rng Is Nothing Then
   Cells(i, 4) = 0
Else
   Cells(i, 4) = 1
End If
Next i
End Sub

评分

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

查看全部评分

回复

使用道具 举报

 楼主| 发表于 2017-6-1 11:47 | 显示全部楼层

谢谢!可以快速实现!
回复

使用道具 举报

 楼主| 发表于 2017-6-1 11:49 | 显示全部楼层
七彩屋 发表于 2017-6-1 11:28
Sub qcw()
Dim r, i, rng
r = Range("a65536").End(xlUp).Row

你的也可以快速实现   
能设置两个最佳答案吗?
回复

使用道具 举报

发表于 2017-6-1 12:31 | 显示全部楼层
本帖最后由 彩虹战士 于 2017-6-1 12:33 编辑

这个也能实现:
Sub 按钮1_Click()
    Dim i, j
    i = 2
    While Cells(i, 2) <> ""
    '从第2列的第2行开始行循环,直到第2列没有数据
        Cells(i, 4) = 1
        '先将该循环行的辅助列数据设为1
        For j = i To 2 Step -1
            If Cells(i, 2) = Cells(j - 1, 2) Then
                Cells(i, 4) = 0
            End If
        Next j
        '从循环行开始向上每一行查找,如果其中有一行的数据与该循环相同,就把该循环行的辅助列数据改为0
    i = i + 1
    Wend
End Sub
回复

使用道具 举报

 楼主| 发表于 2017-6-2 08:35 | 显示全部楼层
彩虹战士 发表于 2017-6-1 12:31
这个也能实现:
Sub 按钮1_Click()
    Dim i, j

谢谢你  你的代码也可以快速实现!
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-29 16:30 , Processed in 1.059565 second(s), 10 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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