ExcelHome技术论坛

 找回密码
 免费注册
QQ登录 只需一步,快速开始
   
高效办公必会的Office99uu优优 永久免费,网表让Excel秒变数据库 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! 国内首部Excel函数公式学习大典 职场充电黑科技, Office微99uu优优 免费下载Excel行业应用视频
300集Office 2010微99uu优优 Tableau-数据可视化工具 突破Excel限制,用活字格提高效率 12门Excel免费公开课任你学
你的Excel 201099uu优优学习锦囊 欲罢不能, 过目难忘的 Office 新界面 免费的Excel考勤计算系统
查看: 177|回复: 10
打印 上一主题 下一主题

[求助] 求助大家,十万火急,单位需要统计,求各位大神指点

[复制链接]
TA的精华主题TA的得分主题
跳转到指定楼层
1
发表于 2018-1-11 18:00 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
本帖最后由 zyyhbg 于 2018-1-12 08:59 编辑

Sub lqxs()
Dim Arr, i&, d, r%, Arr1()
Set d = CreateObject("Scripting.Dictionary")
Sheet1.Activate
Arr = [a1].CurrentRegion
For i = 1 To UBound(Arr)
    d(Arr(i, 2)) = i
Next
For i = 1 To UBound(Arr)
    If d.exists(Arr(i, 1)) Then
        d.Remove (Arr(i, 1))
    Else
        r = r + 1
        ReDim Preserve Arr1(1 To r)
        Arr1(r) = Arr(i, 1)
    End If
Next
[a:b].ClearContents
If d.Count > 0 Then [b1].Resize(d.Count, 1) = Application.Transpose(d.keys)
If r > 0 Then [a1].Resize(r, 1) = Application.Transpose(Arr1)
End Sub
在论坛上找了一位前辈做的,但是无法根据情况分行进行重复删除,求大神给与指点

捕获.PNG (20.23 KB, 下载次数: 0)
捕获.PNG
重复删除求助.zip 11.31 KB, 下载次数: 1
分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏 分享分享 有用有用 无用无用
TA的精华主题TA的得分主题
2
发表于 2018-1-11 18:36 | 只看该作者
简单的遍历单元格就可以了
TA的精华主题TA的得分主题
3
发表于 2018-1-11 18:37 | 只看该作者
难倒是不难,但处理起来就麻烦,奇葩的格式。路过。
TA的精华主题TA的得分主题
4
发表于 2018-1-11 18:37 | 只看该作者
建议楼主上传附件,结合附件内容描述具体需求的
TA的精华主题TA的得分主题
5
 楼主| 发表于 2018-1-11 19:25 来自手机 | 只看该作者 |楼主
dailunchuan 发表于 2018-1-11 18:36
简单的遍历单元格就可以了

但是如何指定删除相同数值,需要它自动按照不同的分类,例如水果这些,删除相同数字,最后仅仅保留首尾数字?
TA的精华主题TA的得分主题
6
发表于 2018-1-11 19:29 | 只看该作者
本帖最后由 duquancai 于 2018-1-11 19:31 编辑

你把鸡蛋合并了?你把水果合并了?这样的“源数据表”不规范,属于垃圾表!
TA的精华主题TA的得分主题
7
 楼主| 发表于 2018-1-11 19:40 来自手机 | 只看该作者 |楼主
duquancai 发表于 2018-1-11 19:29
你把鸡蛋合并了?你把水果合并了?这样的“源数据表”不规范,属于垃圾表!

那如果没有合并,可以实现吗??
TA的精华主题TA的得分主题
8
 楼主| 发表于 2018-1-12 09:00 | 只看该作者 |楼主
TA的精华主题TA的得分主题
9
发表于 2018-1-12 09:18 | 只看该作者
  • Sub test()
  •   Dim r%, i%
  •   With Worksheets("sheet1")
  •     r = .Cells(.Rows.Count, 1).End(xlUp).Row
  •     For i = 1 To r
  •       If .Cells(i, 3).MergeArea.Cells(1, 1).Address = .Cells(i, 3).Address Then
  •         s = .Cells(i, 3).MergeArea.Rows.Count
  •         .Cells(i, 2) = .Cells(i + s - 1, 2)
  •       Else
  •         .Cells(i, 1) = ""
  •         .Cells(i, 2) = ""
  •       End If
  •     Next
  •   End With
  • End Sub
  • 复制代码
    TA的精华主题TA的得分主题
    10
    发表于 2018-1-12 09:19 | 只看该作者
    详见附件。
    重复删除求助.rar 13.42 KB, 下载次数: 10
    您需要登录后才可以回帖 登录 | 免费注册
    本版积分规则
    关闭

    最新热点上一条 /1 下一条

    关注官方微信,每天坐享新鲜教程
    手机版|关于我们|联系我们|ExcelHome    GMT+8, 2018-1-21 16:49 , Processed in 0.077651 second(s), 11 queries , Gzip On, MemCache On.
    Powered by Discuz! X3.3 © 2001-2017 Wooffice Inc.
        沪公网安备 31011702000001号 沪ICP备11019229号 本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:徐怀玉律师 李志群律师
    快速回复 返回顶部 返回列表
    99uu优优