[發問] 請問如何將A檔案(連續性)的資料，經過篩選後寫入B檔案的指定欄位中呢？

kuhsuanchieh

目前有數個連續編號的檔案（例如：test_1　到　10），
裡面的欄位條件都一樣，例如A=姓名、B=日期、C=時間、D=分數、E=大小.......................，但是有些有重複或空欄位，
我想將這些檔案合併寫到一個檔案裡（例如：DATA），但是只挑選某些欄位寫入，寫入後欄位變成A=姓名、B=
分數、C=大小..................，且原始檔案中若有重複不分不要寫入，
請問VBA怎麼來撰寫？

kuhsuanchieh

回復 1# Hsieh
感謝版主Hsieh提醒，說明如下

下載 (49.94 KB)

2015-7-14 23:25

下載 (129.19 KB)

2015-7-14 23:25

測試資料夾.rar (28.69 KB)

下載次數: 10

2015-7-14 23:26

GBKEE

回復 2# kuhsuanchieh
試試看

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim D As Object, AR As Variant, i As Long, XPath As String, Wb As String
   
4.     Set D = CreateObject("SCRIPTING.DICTIONARY")     '字典物件
   
5.     '將這些檔案合併寫到一個檔案裡（例如：DATA），
   
6.     '目前有數個連續編號的檔案（例如：test_1　到　10），
   
7.     XPath = "d:\test\ " '設有數個連續編號的檔案存於同一資料夾
   
8.     Wb = Dir(XPath & "Test_*.xls")    '查詢指定所需的檔案
   
9.     Application.ScreenUpdating = False
   
10.     Do While Wb <> ""                  '查詢到所需的檔案
    
11.         With Workbooks.Open(XPath & Wb).Sheets(1).UsedRange
    
12.             '開啟檔案第一個工作表的使用範圍
    
13.             For i = 2 To .Rows.Count    '第2列到最後一列
    
14.                 With .Rows(i)
    
15.                     AR = Array(.Cells(1, "c"), .Cells(1, "L"), .Cells(1, "D"), .Cells(1, "M"), .Cells(1, "F"))
    
16.                     '讀取 C,L,D,M,F 欄位資料
    
17.                     D(Join(AR, ",")) = ""  '寫入字典物件的Key值
    
18.                 End With
    
19.             Next
    
20.             .Parent.Parent.Close      '關閉開啟的檔案
    
21.             '.UsedRange的[Parent]-> .Sheets(1)的[Parent] -> Workbooks
    
22.         End With
    
23.         Wb = Dir   '下一個 查詢的檔案
    
24.     Loop
    
25.    
    
26.     '如[DATA.xlsx] 未開啟用下式程式碼
    
27.     'With Workbooks.Open(XPath & "\" & DATA.xlsx).Sheets(1)
    
28.    
    
29.     With Workbooks("DATA.xlsx").Sheets(1)
    
30.         For i = 2 To .UsedRange.Rows.Count
    
31.             AR = Application.Transpose(Application.Transpose(.UsedRange.Rows(i).Value))
    
32.             If D.exists(Join(AR, ",")) Then D.Remove Join(AR, ",")
    
33.             '字典物件 Remove 方法,從一個 Dictionary 物件中移除一個關鍵字和項目對。
    
34.         Next
    
35.         For Each AR In D.keys   '移除相同Key(關鍵字)後剩下的D.keys
    
36.             i = .[A1].End(xlDown).Row
    
37.             i = IIf(i = .Rows.Count, 2, i + 1) 'i=最後一列的列數,i=2,否i+1
    
38.             With .Cells(i, "A").Resize(, 5)
    
39.                 .Value = Split(AR, ",")
    
40.                 .Cells(5).NumberFormatLocal = "[>99999999]0000-000-000;000-000-000"
    
41.                 .Value = .Value   '數字為文字格式轉為數字格式
    
42.             End With
    
43.        Next
    
44.        .Save   '存檔
    
45.     End With
    
46.     Application.ScreenUpdating = True
    
47. End Sub

複製代碼

kuhsuanchieh

回復 3# GBKEE


感謝您的幫忙，已經解決了！

謝謝！