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考勤计算系统
查看: 268|回复: 14
打印 上一主题 下一主题

[求助] 如何用VBA计算?

[复制链接]
TA的精华主题TA的得分主题
跳转到指定楼层
1
发表于 2018-2-13 10:51 | 只看该作者 |只看大图 回帖奖励 |倒序浏览 |阅读模式
本帖最后由 On_fire 于 2018-2-13 11:47 编辑

如何用VBA计算?

A列是日期 (输出结果, 要改成yyyymmdd的格式)
B列是数值(当同行C列的值是5或更小, 自动减1, 输出结果)
C列是数值(判断B列不要减1)

F列是模拟结果 (A & B & C)

因数据N多(超10W行), 请老师, 大神帮忙…谢谢…

CAL.jpg (36.75 KB, 下载次数: 1)
CAL.jpg
TA的精华主题TA的得分主题
2
发表于 2018-2-13 11:04 | 只看该作者
请来个附件。。。。。。
TA的精华主题TA的得分主题
3
发表于 2018-2-13 11:16 | 只看该作者
TA的精华主题TA的得分主题
4
 楼主| 发表于 2018-2-13 11:25 | 只看该作者
皓月惊虹 发表于 2018-2-13 11:04
请来个附件。。。。。。

谢谢老师, 源文件太大, 上不了, 这是模拟的文件

cal.zip 8.29 KB, 下载次数: 13
TA的精华主题TA的得分主题
5
 楼主| 发表于 2018-2-13 11:26 | 只看该作者
TA的精华主题TA的得分主题
6
发表于 2018-2-13 11:48 | 只看该作者
在此基础稍加修改即可!
连接测试.png (34.96 KB, 下载次数: 0)
连接测试.png
TA的精华主题TA的得分主题
7
发表于 2018-2-13 11:55 | 只看该作者
try this:
  • Sub zz()
  • Dim a, rng As Range, r&
  • Application.ScreenUpdating = 0
  • Columns("a:b").Insert
  • Set rng = Range("a1:i" & Cells(Rows.Count, 3).End(3).Row)
  • a = rng.Value
  • For i = 1 To UBound(a)
  •     a(i, 1) = i
  •     If a(i, 5) <= 5 Then
  •         a(i, 2) = i
  •         a(i, 8) = a(i, 3) & "&" & a(i, 4) - 1 & "&" & a(i, 5)
  •     Else
  •         a(i, 8) = a(i, 3) & "&" & a(i, 4) & "&" & a(i, 5)
  •     End If
  • Next
  • [a1].Resize(i - 1, 8) = a
  • rng.Sort key1:=rng(2), order1:=1, Header:=0
  • r = Cells(Rows.Count, 2).End(3).Row
  • Union(Range("d1:d" & r), Range("h1:h" & r)).Interior.Color = 65535
  • Range("e1:e" & r).Interior.Color = 60000
  • rng.Sort key1:=rng(1), order1:=1, Header:=0
  • Columns("a:b").Delete
  • Application.ScreenUpdating = 1
  • End Sub
  • 复制代码

    评分

    参与人数 1鲜花 +2 收起 理由
    On_fire + 2 感谢帮助
    查看全部评分
    TA的精华主题TA的得分主题
    8
    发表于 2018-2-13 11:55 | 只看该作者
    我自己机器跑跑还挺快的
  • Sub aaa()
  • Dim arr, i&
  • arr = Range("a1:f" & Cells(Rows.Count, 1).End(3).Row)
  • For i = 1 To UBound(arr)
  • If arr(i, 3) <= 5 Then
  •   arr(i, 6) = Format(arr(i, 1), "yyyymmdd") & "&" & (arr(i, 2) - 1) & "&" & arr(i, 3)
  • Else
  •   arr(i, 6) = Format(arr(i, 1), "yyyymmdd") & "&" & arr(i, 2) & "&" & arr(i, 3)
  • End If
  • Next
  • [a1].Resize(UBound(arr), UBound(arr, 2)) = arr
  • End Sub
  • 复制代码

    评分

    参与人数 1鲜花 +2 收起 理由
    On_fire + 2 感谢帮助
    查看全部评分
    TA的精华主题TA的得分主题
    9
     楼主| 发表于 2018-2-13 12:09 | 只看该作者
    TA的精华主题TA的得分主题
    10
     楼主| 发表于 2018-2-13 12:10 | 只看该作者
    您需要登录后才可以回帖 登录 | 免费注册
    本版积分规则
    关闭

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

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