前景提要

最近在討論工作薄匯總和合并數(shù)據(jù)方面的問題舱殿，各種反饋也是比較的多室囊，最近有小伙伴們表示他們?cè)賲R總數(shù)據(jù)的時(shí)候忍啸，并不需要將文件夾內(nèi)的所有的工作薄都匯總择份，他們需要的是按照工作薄名字的關(guān)鍵自來(lái)匯總胡桨，比方說(shuō)****商城官帘，****分店這樣的模式，其他的并不包含這些關(guān)鍵字段的工作薄就不需要匯總了昧谊，好像這樣的場(chǎng)景比較常用在各分店刽虹，店鋪統(tǒng)計(jì)銷售量的時(shí)候使用，既然大家有需要呢诬，小編就來(lái)分享下這個(gè)問題的解法

場(chǎng)景模擬

我們用之前模擬過(guò)的各商城的數(shù)據(jù)來(lái)模擬下場(chǎng)景涌哲，假設(shè)我們需要匯總當(dāng)前香港地區(qū)的產(chǎn)品的銷量，但是香港地區(qū)的產(chǎn)品銷量分布在兩個(gè)表格中尚镰，一個(gè)是香港阀圾，一個(gè)是港臺(tái)，其他的工作薄的數(shù)據(jù)和我們就沒有任何的關(guān)系了狗唉，我們只需要匯總這兩個(gè)工作薄的數(shù)據(jù)初烘，那么我們來(lái)嘗試下，如何實(shí)現(xiàn)

image.png

image.png

方法分析

從案例中來(lái)看分俯，兩個(gè)表的數(shù)據(jù)和字段并不相同肾筐，姓名不同，字段順序和字段內(nèi)容都不相同澳迫，這個(gè)我們?cè)谥皩W(xué)習(xí)過(guò)了如何實(shí)現(xiàn)了局齿，用數(shù)組的方法就可以了剧劝，我們今天還有一個(gè)關(guān)鍵點(diǎn)橄登，判斷工作薄的名字中是否含有關(guān)鍵字，在之前我們學(xué)習(xí)過(guò)判斷字符串中是否含有某字符讥此，我們可以使用like()函數(shù)來(lái)實(shí)現(xiàn)拢锹，那么關(guān)鍵字從何而來(lái)呢，當(dāng)然是通過(guò)輸入的方式來(lái)得到咯萄喳，inputbox()卒稳，又是我們前面學(xué)習(xí)過(guò)的知識(shí)點(diǎn)，那么方法都有了他巨，我們動(dòng)手吧

代碼區(qū)

Sub 工作薄名字中含有關(guān)鍵字()

Dim arrT()

Set sbook = ActiveWorkbook

GuanJian = Application.InputBox("請(qǐng)輸入關(guān)鍵字", "關(guān)鍵字的確認(rèn)", , , , , , 3)

With Application.FileDialog(msoFileDialogFolderPicker)

    If .Show = -1 Then

        pathn = .SelectedItems(1)

    End If

    f = Dir(pathn & "\")

    Do While f <> ""

        If f Like "*" & GuanJian & "*" Then

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

        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

        f = Dir()

    Loop

End With

End Sub

我們來(lái)看看最終的效果

image.png

僅僅是合并了我們需要合并的兩個(gè)工作薄的數(shù)據(jù)充坑，其他的工作薄數(shù)據(jù)并沒有匯總减江，這樣得到的數(shù)據(jù)更加的精確