Excel/VB 将文件A的数据（源数据）提取到文件B（目标文件）

2024-07-12 12:51| 来源: 网络整理| 查看: 265

问题背景

如果一切数据都跑在后台，数据之间的迁移在全部自动化的情况下，无疑使用csv+python等处理更理想。但不是什么都能全自动化的，如果数据的输入都是excel，而且还要能方便的在所有人的机器上跑，那基于excel的VB来实现一些简单数据处理也是非常方便的。咳咳，扯远了。这章总结的是，如何从一个固定格式的工作表A，提取出想要的数据，按自己设定好的格式，写入另一个工作表B。

设计思路 1、需要掌握的技能需要掌握获取文件路径、文件的打开和关闭等文件操作（实际实现时我都是ctrl+A全选然后ctrl+V贴到专门准备好的一个工作表里，怎么方便怎么来了）需要知道怎么一行行/一列列地遍历指定工作表的有效数据，核心是，用For循环，循环条件是有效行的行号/列号知道行号/列号，能方便的读写该行/列任意单元格的值用IF ELSE对获取到的值进行条件处理 2、实现逻辑 For循环，遍历源文件A的标志数据列[A]IF条件检查[A]的值"aa"的有效性，满足条件则准备处理目标文件BFor循环，遍历目标文件B的目标数据列[B]IF条件检查[B]的整列值里是否包含"aa"，包含则按同类项累加，不包含则遍历结束后新增"aa"行根据实际情况，步骤2和4会增加一定复杂度，但总体逻辑都可以拆分为1~4步骤的结合模块功能实现 VBA文件路径获取、文件的打开、关闭 Sub DemoFileOp() Dim WbookSrc paths = ThisWorkbook.Path & "\" '获取当前路径 Set WbookSrc = Workbooks.Open(paths & "Src.xlsx") '打开源excel文件 ...... '关闭释放内存，否则高频操作excel会挂 WbookSrc.Quit Save:=True '保存excel Set WbookSrc = Nothing '释放内存 End Sub

PS: 如果输入输出不是多个文件，一般来说手动复制源数据到工作表里会更方便。这个只是我一开始查到可以这么玩，实际操作把这块砍掉了。这里放着看以后有需要的时候再捡起来。

VBA For循环对数据行/列遍历 '****************************** 遍历行 ****************************** Sub DemoForRow() Dim SrcRcdNum For SrcRcdNum = 2 To ThisWorkBook.Worksheets(1).Range("A65536").End(xlUp).Row '遍历A列 On Error Resume Next '出了异常继续 MsgBox Range("A" & SrcRcdNum) '通过Range获取数据 If ThisWorkbook.Worksheets(1).Range("A" & SrcRcdNum) = "aa" Then 'For循环的条件退出 Exit For End If Next End Sub '****************************** 遍历列 ****************************** Sub DemoForColumn() Dim SrcColNum For SrcColNum = 1 To ThisWorkbook.Worksheets(1).Range("AZ2").End(xlToLeft).Column '遍历第2行 If ThisWorkbook.Worksheets(1).Cells(2, SrcColNum) = "aa" Then '列遍历使用Cells(行号，列号)，避免数值和字母的转换 Exit For End If Next End Sub

PS: VB的格式没有严格的缩进，但我觉得最好按python的习惯去写。

根据行号、列号获取单元格的值 Range("A" & SrcRcdNum) '通过Range获取数据，需要"A65535"这样的字符串表示的单元格 Cells(2, SrcColNum) '通过Cells获取数据，需要按（行号，列号）填充数据，如Cells(1,2)表示"B1" 用IF ELSE进行条件处理 If "OK" = ThisWorkbook.Worksheets(1).Range("E" & SrcRcdNum) Then Flag = 1 ElseIf "Pending" = ThisWorkbook.Worksheets(1).Range("E" & SrcRcdNum) Then Flag = 2 Else Flag = 255 End If

PS: 对于多种情况的处理，比较清晰的方式是用标志位，等跳出循环后，再按标志位的值处理（扩展性好）。跳出循环时，行号列号仍是保留的。

DEMO

这里要实现的是，根据系统导出的昨日订单数据（每行源数据含订单号、产品编码、产品名称、订单状态、产品数量），生成产品每日销量表。

Sub UpdateOrder() '定义VBA工作表操作相关的变量 Dim SrcRcdNum Dim DstRcdNum Dim ExistFlag '****************************** UpdateOrder ****************************** '根据订单生成销售数据 For SrcRcdNum = 2 To ThisWorkbook.Worksheets("昨日订单").Range("A65536").End(xlUp).Row '遍历Src A列，所有订单号 '标志位清零 ExistFlag = 0 On Error Resume Next '出了异常继续 For DstRcdNum = 2 To ThisWorkbook.Worksheets("生成数据").Range("A65536").End(xlUp).Row '遍历Dst 产品编码列 If ThisWorkbook.Worksheets("昨日订单").Range("B" & SrcRcdNum) = ThisWorkbook.Worksheets("生成数据").Range("A" & DstRcdNum) Then '产品编码相等，记下该行，跳出循环 ExistFlag = 1 '产品编码相等，flag = 1 Exit For End If Next '根据flag标志进行目的文件更新 'ExistFlag = 0, 产品编码不存在，全部新建数据 If ExistFlag = 0 Then ThisWorkbook.Worksheets("生成数据").Range("A" & DstRcdNum) = ThisWorkbook.Worksheets("昨日订单").Range("B" & SrcRcdNum) '产品编码 ThisWorkbook.Worksheets("生成数据").Range("B" & DstRcdNum) = ThisWorkbook.Worksheets("昨日订单").Range("C" & SrcRcdNum) '产品名称 '根据Cancelled判断是不是有效订单 If "Cancelled" ThisWorkbook.Worksheets("昨日订单").Range("D" & SrcRcdNum) Then 'Src D列，订单状态 ThisWorkbook.Worksheets("生成数据").Range("C" & DstRcdNum) = ThisWorkbook.Worksheets("昨日订单").Range("E" & SrcRcdNum) 'Src E列，产品销售的数量 Else ThisWorkbook.Worksheets("生成数据").Range("D" & DstRcdNum) = 1 '取消订单的次数 End If 'ExistFlag = 1, 存在产品编码，累加数据 ElseIf ExistFlag = 1 Then If "Cancelled" ThisWorkbook.Worksheets("昨日订单").Range("E" & SrcRcdNum) Then ThisWorkbook.Worksheets("生成数据").Range("C" & DstRcdNum) = ThisWorkbook.Worksheets("生成数据").Range("C" & DstRcdNum) + ThisWorkbook.Worksheets("昨日订单").Range("E" & SrcRcdNum) '数量叠加 Else ThisWorkbook.Worksheets("生成数据").Range("D" & DstRcdNum) = ThisWorkbook.Worksheets("生成数据").Range("D" & DstRcdNum) + 1 '累加取消订单的次数 End If End If Next End Sub 扩展 1.动态比较日期

月度销量汇总的话，需要根据当前日期去匹配总表里的日期，才知道要更新哪列。在单元格Cells(2,2)设定值为=NOW()，再设置单元格格式为"3月14日"，即忽略时分秒。实际比较中，NOW函数获取到的系统时间，整数位表示年月日，小数位表示时分秒，我们"ctrl+:"指定的日期是只有年月日的，在比较前需要对Cells(2,2)做取整处理。对了，时间虽然可以调格式显示成字符，实际应该仍是数值。在这里插入图片描述

... '获取匹配今日的列号 For DstRcdNum = 7 To ThisWorkbook.Worksheets(1).Range("AZ3").End(xlToLeft).Column '遍历第3行，汇总表一般不超过1个月，AZ够了 If ThisWorkbook.Worksheets(1).Cells(3, DstRcdNum) = Fix(ThisWorkbook.Worksheets(1).Cells(2, 3)) Then '比较日期，是否为今日 TodayColumn = DstRcdNum Exit For End If Next ... 2.条件格式高亮单元格

当某日库存小于某个周期的销量时，最好能高亮该产品，以提醒发货。在这里插入图片描述找到条件格式新建一个规则，比较大小，满足条件则填充指定颜色即可。开始 - 样式 - 条件格式 - 新建规则按公式，选两个目标单元格比较，然后指定应用范围。有时想按指定的行号高亮单元格，比如奇偶行高亮，每隔10行高亮等等，方便查看数据。可以按以下公式设置条件格式：

公式: =MOD(ROUNDUP((ROW()-1)/11,0),2)=1 #这里是每隔11行满足一次条件

在这里插入图片描述 MOD：取余函数，第一参数是除数，第二参数是被除数，这里套用奇偶行高亮规则，只要余数=1就高亮 ROUNDUP：进一取整函数，第一参数是带小数的数，第二参数是要保留的小数位，第二参数取0，实现进一取整 ROW：获取行号，第一行是标题，所以减1，我要按11行高亮，所以除以11 效果如下：在这里插入图片描述

3.动态获取周期范围的值

诉求是能根据当前日期动态的获取7日销量的数据。由于这些数据都是显式呈现在excel上，只需要简单求和，难的是根据日期去匹配指定的列号。这个表是一个月备一次，1号到31号的列号其实是固定的。以1号为基准列号，可以根据今日日期的值减去1号的值得到今日日期和1号日期的列号差，用1号的基准列号加上这个差值就能得到今日数据所在的列号。

假设F34是任意一个产品，I20是X月1号的日期，C2是=NOW()（当前日期）获取今日该产品销量所在单元格的值： =INDIRECT(ADDRESS(CELL(“row”,F34),CELL(“col”,I20)+INT(C2-I20)))

说明：Address获取某个产品的行号，列号由X月1号的列号加上列号差得到

获取到1天，7日的就是逐级往左取值。

=INDIRECT(ADDRESS(CELL(“row”,F34),CELL(“col”,I20)+INT(C2-I20)))+IF(INT(C2-I20)-1>0, INDIRECT(ADDRESS(CELL(“row”,F34),CELL(“col”,I20)+INT(C2-I20)-1)), 0)+IF(INT(C2-I20)-2>0,INDIRECT(ADDRESS(CELL(“row”,F34),CELL(“col”,I20)+INT(C2-I20)-2)), 0)+IF(INT(C2-I20)-3>0,INDIRECT(ADDRESS(CELL(“row”,F34),CELL(“col”,I20)+INT(C2-I20)-3)), 0)+IF(INT(C2-I20)-4>0,INDIRECT(ADDRESS(CELL(“row”,F34),CELL(“col”,I20)+INT(C2-I20)-4)), 0)+IF(INT(C2-I20)-5>0,INDIRECT(ADDRESS(CELL(“row”,F34),CELL(“col”,I20)+INT(C2-I20)-5)), 0)+IF(INT(C2-I20)-6>0,INDIRECT(ADDRESS(CELL(“row”,F34),CELL(“col”,I20)+INT(C2-I20)-6)), 0)

【本文地址】

公司简介

联系我们