ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

   
EH云课堂-专业的职场技能充电站 限时送,魔方网表将Excel变在线系统 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel 2016函数公式学习大典 高效办公必会的Office实战技巧 免费下载Excel行业应用视频
300集Office 2010微视频教程 Tableau-数据可视化工具 精品推荐-800套精选PPT模板,点击获取 ExcelHome出品 - VBA代码宝免费下载
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 Excel VBA经典代码实践指南
查看: 241|回复: 6
打印 上一主题 下一主题

[求助] VBA输入去重复

[复制链接]

ag娱乐平台手机版, 乐视控股常驻洛杉矶、负责战略合作和投资的高级副总裁聂天心回复新华社记者采访时说:“FF是乐视的战略合作伙伴,今年1月份的CES上,FF发布了首款概念车FF ZERO1,并且对外宣布了两家公司的战略合作伙伴关系……贾总已经宣布乐视汽车项目首轮融资10.8亿美金;最近又宣布将会融得6亿美金,其中相当一部分将用于乐视汽车项目。”他也表示,贾跃亭是FF的个人投资者之一,会继续支持FF的发展。

“青春蓝舰队”充分发挥创新力强的优势,推行独具特色的“套餐”纳税服务。对重点税源企业推行重点层纳税服务体制,即“贵宾餐”。对14户重点企业实行重点联系户制度,深入企业“听需求、征意见、送政策、优服务”,帮助企业解决生产经营中遇到的难题。局领导先后组织青年业务骨干和其他业务专家到广西中烟公司、南宁烟草公司等多家企业,开展涉税风险提醒、税企高层对话、财税人员互动性业务交流等个性化纳税服务;对成熟企业采取行业层服务体制,即“特色餐”。以行业为对象进行纳税服务,建立以“风险防范为主”的纳税人权益保护机制。按照管理与服务一体化要求,开展涉税政策咨询和现场辅导,解决因税收政策调整给纳税人带来的不便;对所有纳税人实行普通层纳税服务体制,即“营养餐”。对新办企业的财务人员,开展税收法律法规培训,通过发放税收宣传资料、政策辅导等形式开展多种多样的服务活动;通过电话、短信等形式提供提醒服务。2015年以来,共举办纳税人培训班15期,参加人数达5万多人(次)。“青春蓝舰队”还积极探索现代化纳税服务方式,开通新浪微博,组建7个企业QQ群,群成员达2650名,组建答疑小组,及时解答纳税人提出的各类涉税问题,实现税收宣传及时、广泛、有效的目标。 消息称中国或允许国内投资者交易在美上市中资股从一定意义来说,德布劳内是球队的护身符,只要他在英超出场,曼城就可以至少保持不败金身。《太阳报》指出,在2016年度,德布劳内的22个不败场次在英超球员里是最高的,可见他的出色。

TA的精华主题

TA的得分主题

跳转到指定楼层
1
发表于 2019-1-11 23:59 | 只看该作者 |只看大图 回帖奖励 |倒序浏览 |阅读模式
要求:
1、根据日期和班次条件进行去重,只保留最新输入的那一个数据;
2、以最后一次输入的数值为最新数值,删除之前重复项保留最后一次输入数值

捕获.JPG (117.2 KB, 下载次数: 0)

捕获.JPG

ag娱乐平台手机版测试.zip

27.25 KB, 下载次数: 4

去重复

ag娱乐平台手机版TA的精华主题

TA的得分主题

2
发表于 2019-1-12 08:06 | 只看该作者

TA的精华主题

TA的得分主题

3
发表于 2019-1-12 08:53 | 只看该作者
字典去重就解决了

0101.gif (222.82 KB, 下载次数: 1)

0101.gif

测试.zip

24.67 KB, 下载次数: 7

TA的精华主题

TA的得分主题

4
发表于 2019-1-12 09:13 | 只看该作者
不用字典啊,为什么要用字典,数据是一行一行输入的,不是一下就输入一堆数据。
Private Sub CommandButton1_Click()
    Dim X%, Y%, new_arr, old_arr, i, j
    With Sheet1
        'Rows.Count表格总行数
        X = .Cells(Rows.Count, "B").End(xlUp).Row + 1 'xlUP向上查找range非空单元格.行号
        j = 1
        If ComboBox1.Text = "" Or TextBox1.Text = "" Then
            MsgBox "请输入数据", , "提示" '弹出消息窗口
            Exit Sub '退出程序
        Else
             old_arr = .Range("B2:E" & X) '源数据写入数组old_arr
            ReDim new_arr(1 To UBound(old_arr) + 1, 1 To 4) '重新定义数组大小new_arr(行,列)
            For i = 1 To UBound(old_arr)
                '源数据除开新输入班次外的数据写入数组new_arr
                If old_arr(i, 3) <> "" And old_arr(i, 3) <> ComboBox1.Text Then
                    new_arr(j, 1) = j '第1列序号
                    new_arr(j, 2) = old_arr(i, 2) '第2列日期
                    new_arr(j, 3) = old_arr(i, 3) '第3列班次
                    new_arr(j, 4) = old_arr(i, 4) '第4列产量
                    j = j + 1 '变量j+1
                End If
            Next i
            '新输入班次的数据写入数组new_arr最后1行
            new_arr(j, 1) = j '第1列序号
            new_arr(j, 2) = Format(Now, "yyyy-m-d") '第2列日期
            new_arr(j, 3) = ComboBox1.Text '第3列班次
            new_arr(j, 4) = TextBox1.Text '第4列产量
            '处理好的数组new_arr写回表格
            .Range("B2:E" & X) = "" '清空源数据
            .Range("B2:E" & j + 1) = new_arr '写回
        End If
    End With
End Sub


TA的精华主题

TA的得分主题

5
 楼主| 发表于 2019-1-19 14:08 | 只看该作者
MOY838840554 发表于 2019-1-12 09:13
不用字典啊,为什么要用字典,数据是一行一行输入的,不是一下就输入一堆数据。
Private Sub CommandButto ...

已经达到我要求的意思,我想问一个问题,就是如果这个表格是整年度的,在新建组内的数据会不会非常大,导致重新写回表格的时候卡死或者季度缓慢。

TA的精华主题

TA的得分主题

6
 楼主| 发表于 2019-1-19 14:10 | 只看该作者

我的意思就是,每天只能有ABC班的数据存在,其他只要多输入的都是保留最新的产量。

TA的精华主题

TA的得分主题

7
 楼主| 发表于 2019-1-19 14:15 | 只看该作者
microyip 发表于 2019-1-12 08:06
字典去重就解决了

字典去重我不会用,在定义字典之后,如何对比字典内容,并且删除或者覆盖,到了这步我就歇菜了;
然后我照着人家的,依葫芦画瓢,又没有任何作用:
Dim Dic As Object, Dic2 As Object, End_Row_No As Integer, Arr, Brr, rng
Set Dic = CreateObject("Scripting.Dictionary")
Set Dic2 = CreateObject("Scripting.Dictionary")
  With ActiveSheet
    End_Row_No = .[B100000].End(xlUp).Row
    Arr = .Range("C2:C" & End_Row_No)
    Brr = .Range("D2:D" & End_Row_No)
End With
     Set rng = Nothing
For i = UBound(Arr) To 1 Step -1
        For j = UBound(Brr) To 1
        If Dic.exists(Arr(i, 1)) = Format(Now, "yyyy-m-d") Then
         If Dic2.exists(Brr(j, 1)) = ComboBox1.Text Then
             If rng Is Nothing Then
                 Set rng = Cells(i, 1)
             Else
                 Set rng = Union(rng, Cells(i, 1))
             End If
        Else
             Dic(Arr(i, 1)) = 1
         End If
        End If
        Next
        Next
    If Not rng Is Nothing Then rng.EntireRow.Delete
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关注官方微信,高效办公专列,每天发车

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2019-3-22 22:23 , Processed in 0.088129 second(s), 16 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 2001-2017 Wooffice Inc.

   

沪公网安备 31011702000001号 沪ICP备11019229号

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:徐怀玉律师 李志群律师

快速回复 ag娱乐平台手机版 返回列表
男子去机场接女友结果车子突然起火 查出原因惊呆 弈品杯国象公开赛次日竞争激烈 八轮战罢无人全胜 巨资整合直播生态 斗鱼目标不仅是制造下一个冯提莫 美债零风险魅力不再 欧债为投资人提供替代选择 太胖了?曼联大将回应:我是鲁尼身材 显得块头大 中央巡视组:高质量完成一届任期内巡视全覆盖任务 英首相:“神经毒剂事件”很可能是莫斯科幕后指使 曝喝水哥已决定离开切尔西 刚来一年他就要走 直击|UCloud与英特尔战略升级:将联合研发AI等应… 中国首艘国产航母海试 检测动力系统等设备可靠性 臭脚辣眼睛的精华,可能也是美食里你最爱的那一味 王荣委员:支持粤港澳打造世界级大湾区
首批CDR授予8家独角兽 监管层在考虑同股不同权制度 美国给予美企更多时间解除与俄铝业务 铝价应声大跌 男子32元小复式喜中足彩14场近60万 称用奖金创业 因公众号不当回复:魅族向詹姆斯及粉丝公开致歉 土耳其要求美国立即召回发放给叙库武装的武器 切尔西摆加强版大巴又如何?瓜迪奥拉神招直接破 交通运输部:清明假期高速公路小客车免费通行 马哈蒂尔意外胜选对马来西亚经济、市场影响几何 穆加贝下台后津巴布韦首次大选:现身投票给反对派 克洛普砸钱打脸自己?错!穆帅对他羡慕嫉妒恨 区块链里的“罪与罚”:别让风口变成风险! 美债收益率2018年已触顶?BOM分析师是这么认为的
苹果正在研发micro LED面板 大小尺寸通吃 维修铁路试运火车 朝鲜为多国记者团提供便利 23岁男子开挂人生:博士毕业成达摩院最年轻科学家 亚运排球张晨张常宁联袂出征 朱婷期待亚运首秀 证实日军在华屠杀慰安妇影像首公开 拍于云南腾冲 甘肃首单苹果“保险+期货”理赔 辽宁舰编队演习之际 美军罗斯福号航母今日抵南海 郎平:澳门站继续锻炼新人 和强国交手以赛代练 押注5G 诺基亚能否翻盘 皇马队长朝队友抱怨防守:我们像是静止的图片 人物|32岁打出历史第8!没担当的大男孩成熟了 比特币交易平台出海难逃监管:发现一家关闭一家 Facebook主推旗下视频平台Watch 与YouT… ag娱乐平台手机版