Excel 如何設計一個活頁簿去比對抓取多個活頁簿?

大致問題說明:

當把我一些內容貼上一個活頁簿(以下稱報表)後,該報表裡面有產品號碼跟數量,然後報表就會去幫我比對同資料夾內的其他活頁簿(可能有數個活頁簿),並計算各活頁簿裡面的產品數量"加總",是否有符合我本來這個報表貼上的內容。

下載說明檔(用IE瀏覽器連網址進去後點選最下面藍色的那個DOWNLOAD字眼)

http://www.2shared.com/fadmin/55705555/ae7c0c5c/_o...

(FunP免費空間怪怪的,只好上傳到其他空間,沒想到還要註冊。XD)

Update:

下載檔案說明檔(funp 空間下載)

http://www.funp.net/569244

3 Answers

Rating
  • 7 years ago
    Favorite Answer

    <參考檔>:

    http://www.funp.net/109192

    外檔處理比較繁瑣,

    程式雖然都是基礎碼,但對初學者不太易懂,僅能粗略註解~~

    2014-02-02 10:15:58 補充:

    <參考檔.改1版>:

    http://www.funp.net/501678

    1.加入工作表保護之解除及重置

    2.MN欄只是供測試,以了解那二段程式用法,已將按鈕移除

    3.資料夾中,除主檔外,其他檔皆視為統計目標檔,

      程式會自動偵測檔案數量;

      __若有參雜不相關檔案,則目標檔案名稱必須有固定規則

    2014-02-02 22:12:50 補充:

    程式碼只有加入工作表保護解除及重置,其他皆未更動,

    原G.M.N.O欄只是給測試程式比對用,與驗證程式無關。

    套用至實檔時,以下二個測試程式可以刪除:

    Sub 列出檔案清單()

    Sub 列出統計明細()

    2014-02-03 22:11:23 補充:

    EXCEL VBA.統計外部檔案各項目數量.與當前工作表比對驗證

                             <.准提部林.>

    ---------------------------------

    ■程式碼:

     Dim BookArr, ExDic As Object, ExPath$

     

     Sub 驗證()

     Dim y&, UU, GG, uP$, xR As Range

     ExPath = ThisWorkbook.Path & "\"

     Call 檔案清單: If Not IsArray(BookArr) Then Exit Sub

     Call 統計資料: If ExDic.Count = 0 Then Exit Sub

     ActiveSheet.Unprotect "123"

     [H:K].ClearContents

     y = Cells(Rows.Count, "C").End(xlUp).Row

     For Each xR In Range("C2:C" & y + 1)

      If xR = "" Then GoTo 102

      UU = xR(1, 3) - xR(1, 4)

      If UU <= 0 Then xR(1, 6) = "不比對": GoTo 102

      GG = ExDic(xR.Value)

      ExDic.Remove xR.Value

      If UU = GG Then xR(1, 6) = "正確": GoTo 102

      xR(1, 6) = "錯誤": xR(1, 7) = GG - UU

     102: Next

     y = ExDic.Count

     If y > 0 Then

      [J1] = "遺漏號碼": [K1] = "數量"

      [J2].Resize(y) = Application.Transpose(ExDic.keys)

      [K2].Resize(y) = Application.Transpose(ExDic.items)

     End If

     ActiveSheet.Protect "123"

     End Sub

     

     

     Sub 統計資料()

     Dim uBook As Workbook, uSht As Worksheet, uR As Range, BT, y&

     Set ExDic = CreateObject("Scripting.Dictionary")

     Application.ScreenUpdating = False

     For Each BT In BookArr

      For Each uBook In Workbooks

       If uBook.Name = BT Then Exit For

      Next

      If uBook Is Nothing Then Set uBook = Workbooks.Open(ExPath & BT)

      Set uSht = uBook.ActiveSheet

      y = uSht.Cells(Rows.Count, "B").End(xlUp).Row

      For Each uR In uSht.Range("B2:B" & y + 1)

       If uR <> "" Then ExDic(uR.Value) = ExDic(uR.Value) + uR(1, 2)

     Next

     uBook.Close SaveChanges:=False

     101: Next

     End Sub

     

     

     Sub 檔案清單()

     Dim sF$, FileStr$

     BookArr = ""

     Do

      If sF = "" Then sF = Dir(ExPath & "*.xls") Else sF = Dir

      If sF = "" Then Exit Do

      If sF <> ThisWorkbook.Name Then FileStr = FileStr & "|" & sF

     Loop

     FileStr = Mid(FileStr, 2)

     If FileStr <> "" Then BookArr = Split(FileStr, "|")

     End Sub 

    ---------------------------------

    <範例檔>下載:

    檔案名稱:20140129v01(活頁簿抓取比對).rar

    下載連結:http://www.funp.net/501678

    ---------------------------------

  • 7 years ago

    如果你很確定自己很想結婚

    婚友社的確是一個有效率的管道

    年紀越大壓力越大

    以前我去婚友社時

    年輕的女生機會總是比較多

    時間總是不站在女生這邊的

    所以如果你想婚的念頭已經確定

    就去找一家評價好一點的婚友社!

    行動吧!

    這是我之前參加的婚友社我覺得不錯

    或搜尋"紅娘李姐"

    不過還是建議你自己去諮詢過看是否適合你!

  • 7 years ago

    謝謝准提大為我設計的報表,一切就如同我所需,真的太感謝了!

    不過有些問題還是想了解一下:

    1. 除了A~F欄,其他整頁皆有保護鎖定工作表,導致按"驗證"會出錯。

    2. M欄與N欄,列出統計明細的意義是...?

    3. O欄列出檔案,我大概研究了一下,心得是:列出檔案雖然只輸入甲乙丙三個檔名,但若放入丁檔案,還是依舊會抓取是不是?

    2014-02-02 20:40:06 補充:

    這次改版改的好棒!

    除了保護鎖定,最大的差別是不是還有

    1. G欄我不需自己再另外設定E-F的輔助公式了?

    2. 原本O欄列出檔案不見了,所以也無需Key 列出檔案便可自動抓取了?

    2014-02-03 20:33:26 補充:

    問題完全解決了!謝謝!

    准大 請上答唷!

Still have questions? Get your answers by asking now.