Excel VBA工作薄 5.7难度继续飙升 字段都不同的多个工作薄如何汇总

前景提要

在昨天的学习中,我们也是分享了升级版的工作薄汇总的难度,当字段的顺序不同的时候要如何汇总,我们巧妙的利用了数组的方式来判断数据的位置,从而实现相应的字段再粘贴相应的数据的,当然这仅仅是工作中可能碰到的众多情况中的一种,还有童鞋表示字段顺序不同,其实就是小儿科的事情,他们要汇总的数据,不仅仅字段展示顺序不同,而且字段都不相同呢,这里小编内心只想说一句话:你们之前都是怎么熬过来的

场景模拟

我们还是继续只用之前的数据模型吧,我们还是以京东的产品为例子,我们对数据做一些更改,我们将产品2的数据替换成为手机的数据

image.png

为了效果明显一点,我们再更改一个数据源,把香港的数据源中产品3替换成为TVB


image.png

好,通过这番更改,我们再处理数据的时候,就不仅仅是要处理字段顺序的情况了,而且还有字段也不同的情况,难度全面升级,VBA还可以实现吗?

方法分析

方法我们还是来看看正常的手工操作的话,我们需要如何实现,我们需要判断目标工作薄的表头和总工作薄的表头是否一致,在上节我们学习了如果数据顺序不一致的话,我们可以通过数组方式来找到对应的位置,那么今天的情况字段都不相同,我们还可以通过数字的方式来实现吗?当然可以,不过这里我们需要灵活一点,做出一些调整,具体的看代码

代码区

Sub test()

Dim pathn, sth As Workbook, rng As Range, rng1 As Range, sbook As Workbook, arrT, k&

k = 0

pathn = ThisWorkbook.Path

Set sbook = ThisWorkbook

f = Dir(pathn & "\")

Do While f <> ""

    l = Cells(Rows.Count, 1).End(xlUp).Row

    If f <> "test.xlsm" Then

        For Each sth In Workbooks

            If sth.Name = f Then

                GoTo line

            End If

        Next sth

        '=====汇总工作薄的代码======

        k = k + 1

        If k = 1 Then

            Workbooks.Open (pathn & "\" & f)

            Set rng = ActiveSheet.UsedRange

            rng.Copy sbook.Worksheets(1).Cells(1, 1)

            Else

                l1 = Cells(1, Columns.Count).End(xlToLeft).Column

                arrT = Range(Cells(1, 1), Cells(1, l1))

                Workbooks.Open (pathn & "\" & f)

                Set rng = ActiveSheet.UsedRange

                arrW = rng.Rows(1)

                l2 = UBound(arrW, 2)

                For i = 1 To l2

                    On Error Resume Next

                    Num = WorksheetFunction.Match(arrW(1, i), arrT, 0)

                    If Err.Number = 0 Then

                        rng.Columns(i).Offset(1, 0).Copy sbook.Worksheets(1).Cells(l + 1, Num)

                        Else

                            l3 = sbook.Worksheets(1).Cells(1, Columns.Count).End(xlToLeft).Column

                            sbook.Worksheets(1).Columns(l3).Insert

                            sbook.Worksheets(1).Cells(1, l3) = arrW(1, i)

                            rng.Columns(i).Offset(1, 0).Copy sbook.Worksheets(1).Cells(l + 1, l3)

                            ReDim Preserve arrT(1 To 1, 1 To l3 + 1)

                            arrT(1, l3) = arrW(1, i)

                            arrT(1, l3 + 1) = arrW(1, l2)

                    End If

                Next i

        End If

        '=====汇总工作薄的代码======

        ActiveWorkbook.Close True

    End If

line:

    f = Dir()

Loop

End Sub

我们来看看最终的效果


image.png

产品这一列数据都是正常的,同时我们新增加的两个测试时产品,手机和TVB的相关数据都已经成功的汇总到了总数居里面,非常完美的实现了我们的要求

单独看看这两份数据的内容,完美,应该空的地方都空, 应该有数据的地方也正常有数据。nice

image.png
image.png

代码分析

其实今天的代码并么有增加太多的知识点,基本上都是在上节的代码的基础上进行调整和更改的,改动比较大的地方就是增加了一个判断

If Err.Number = 0 Then

                        rng.Columns(i).Offset(1, 0).Copy sbook.Worksheets(1).Cells(l + 1, Num)

                        Else

                            l3 = sbook.Worksheets(1).Cells(1, Columns.Count).End(xlToLeft).Column

                            sbook.Worksheets(1).Columns(l3).Insert

                            sbook.Worksheets(1).Cells(1, l3) = arrW(1, i)

                            rng.Columns(i).Offset(1, 0).Copy sbook.Worksheets(1).Cells(l + 1, l3)

                            ReDim Preserve arrT(1 To 1, 1 To l3 + 1)

                            arrT(1, l3) = arrW(1, i)

                            arrT(1, l3 + 1) = arrW(1, l2)

                    End If

如果我们要汇总的目标表格中的数据在我们的汇总表中没有对应的字段的话,我们需要增加字段。我们来分解下动作

l3 = sbook.Worksheets(1).Cells(1, Columns.Count).End(xlToLeft).Column

sbook.Worksheets(1).Columns(l3).Insert

sbook.Worksheets(1).Cells(1, l3) = arrW(1, i)

获取汇总表的行的最下下标,并且新插入一列,同时将这一列的表头设置为我们汇总表中缺失的这个表头

rng.Columns(i).Offset(1, 0).Copy sbook.Worksheets(1).Cells(l + 1, l3)

ReDim Preserve arrT(1 To 1, 1 To l3 + 1)

arrT(1, l3) = arrW(1, i)

arrT(1, l3 + 1) = arrW(1, l2)

这一段是本段代码中最难以理解的部分,因为我们的数据源中,总计那一列的数据应该是放在最后面的,所以我们增加的字段都应该放在总计这一列的前面,所以这里就需要利用数组的动态添加和重新赋值,我们将原来的总计这个字段对应的位置让给新增加的字段的位置,然后把新增加的那一列的数据替换成为总计,这里比较绕,大家要多理解下,来截图看看实际效果

这是替换之前的数组的状态


image.png

第5个位置是总结,新增加的列在数组中是空白的

来看看替换后的效果

image.png

成功的完成了数据的位置的替换和数组的更新

最终的状态是这样的

image.png
©著作权归作者所有,转载或内容合作请联系作者
  • 序言:七十年代末,一起剥皮案震惊了整个滨河市,随后出现的几起案子,更是在滨河造成了极大的恐慌,老刑警刘岩,带你破解...
    沈念sama阅读 199,393评论 5 467
  • 序言:滨河连续发生了三起死亡事件,死亡现场离奇诡异,居然都是意外死亡,警方通过查阅死者的电脑和手机,发现死者居然都...
    沈念sama阅读 83,790评论 2 376
  • 文/潘晓璐 我一进店门,熙熙楼的掌柜王于贵愁眉苦脸地迎上来,“玉大人,你说我怎么就摊上这事。” “怎么了?”我有些...
    开封第一讲书人阅读 146,391评论 0 330
  • 文/不坏的土叔 我叫张陵,是天一观的道长。 经常有香客问我,道长,这世上最难降的妖魔是什么? 我笑而不...
    开封第一讲书人阅读 53,703评论 1 270
  • 正文 为了忘掉前任,我火速办了婚礼,结果婚礼上,老公的妹妹穿的比我还像新娘。我一直安慰自己,他们只是感情好,可当我...
    茶点故事阅读 62,613评论 5 359
  • 文/花漫 我一把揭开白布。 她就那样静静地躺着,像睡着了一般。 火红的嫁衣衬着肌肤如雪。 梳的纹丝不乱的头发上,一...
    开封第一讲书人阅读 48,003评论 1 275
  • 那天,我揣着相机与录音,去河边找鬼。 笑死,一个胖子当着我的面吹牛,可吹牛的内容都是我干的。 我是一名探鬼主播,决...
    沈念sama阅读 37,507评论 3 390
  • 文/苍兰香墨 我猛地睁开眼,长吁一口气:“原来是场噩梦啊……” “哼!你这毒妇竟也来了?” 一声冷哼从身侧响起,我...
    开封第一讲书人阅读 36,158评论 0 254
  • 序言:老挝万荣一对情侣失踪,失踪者是张志新(化名)和其女友刘颖,没想到半个月后,有当地人在树林里发现了一具尸体,经...
    沈念sama阅读 40,300评论 1 294
  • 正文 独居荒郊野岭守林人离奇死亡,尸身上长有42处带血的脓包…… 初始之章·张勋 以下内容为张勋视角 年9月15日...
    茶点故事阅读 35,256评论 2 317
  • 正文 我和宋清朗相恋三年,在试婚纱的时候发现自己被绿了。 大学时的朋友给我发了我未婚夫和他白月光在一起吃饭的照片。...
    茶点故事阅读 37,274评论 1 328
  • 序言:一个原本活蹦乱跳的男人离奇死亡,死状恐怖,灵堂内的尸体忽然破棺而出,到底是诈尸还是另有隐情,我是刑警宁泽,带...
    沈念sama阅读 32,984评论 3 316
  • 正文 年R本政府宣布,位于F岛的核电站,受9级特大地震影响,放射性物质发生泄漏。R本人自食恶果不足惜,却给世界环境...
    茶点故事阅读 38,569评论 3 303
  • 文/蒙蒙 一、第九天 我趴在偏房一处隐蔽的房顶上张望。 院中可真热闹,春花似锦、人声如沸。这庄子的主人今日做“春日...
    开封第一讲书人阅读 29,662评论 0 19
  • 文/苍兰香墨 我抬头看了看天上的太阳。三九已至,却和暖如春,着一层夹袄步出监牢的瞬间,已是汗流浃背。 一阵脚步声响...
    开封第一讲书人阅读 30,899评论 1 255
  • 我被黑心中介骗来泰国打工, 没想到刚下飞机就差点儿被人妖公主榨干…… 1. 我叫王不留,地道东北人。 一个月前我还...
    沈念sama阅读 42,268评论 2 345
  • 正文 我出身青楼,却偏偏与公主长得像,于是被迫代替她去往敌国和亲。 传闻我的和亲对象是个残疾皇子,可洞房花烛夜当晚...
    茶点故事阅读 41,840评论 2 339

推荐阅读更多精彩内容