標題: [發問] 篩選檔案(附code) 麻煩幫我看一下 謝謝(已自己解決) code稍後附上 [打印本頁]

---

作者: ffntldj    時間: 2011-11-29 21:49     標題: 篩選檔案(附code) 麻煩幫我看一下 謝謝(已自己解決) code稍後附上

本帖最後由 ffntldj 於 2011-12-1 20:17 編輯

遇到以下問題 上來詢問各位高手 請賜教 謝謝

以下是我寫的code (已完成部分)
主要的功能是想要去'C:\tool\output\ 此目錄下面開裡頭的*.XLS檔案,但開啟的檔案須符合以下條件
1:檔案名稱需要符合*檔名關鍵字* ,Word=[b2] 填寫在EXCEL表格中
2.Sheet名稱要符合"ShName",ShName=[b3]  填寫在EXCEL表格中


接下來是我不知道怎麼寫(未完成),煩請幫個忙 謝謝
3.打開檔案後在Sheet(Equi)中,當A+B+C欄位如果都一樣
則將此資料保留一筆(如附檔2,3列),也就是刪除重複的資料
4.在A欄位中只要有包含Filter1~3的內容時,要把資料刪除(假設filter1寫的是300#3_4MPMTR,則第六列整列刪除)
   在'C:\tool\output\的裡面會有好幾個檔案 所以做完一個檔案 就要儲存 關掉,然後在做下一個

以下是小弟的code
Private Sub CommandButton11_click()
Dim sh As Worksheet,NewBK As Workbook
Dim Path$,Word$,ShName$,File$,Tmp$,Filter1$,Filter2$,Filter3$
Path=[b1]     'C:\tool\output\  
Word=[b2]    '檔名關鍵字
ShName=[b3]  'sheet name (Equi)
Filter1=[b4]
Filter2=[b5]
Filter3=[b6]

File= Dir(Path&"*.xls") '收尋檔案
if File="" then go to Ex
first =File
Do
   Tmp=left(File,InStrRev(File,".")-1) '取檔案名
        if InStr(File,Word) Then
      Workbooks.open Path& File
      On Error Resume Next
      Set sh= ActiveWorkbook.Worksheets(ShName)
     On Error GoTo 0
    if Not sh is Nothing Then
     i=i+1
   '此段不會寫'
   sh.Parent.Close False
End If
End If
File= Dir
Loop Until first = File Or File= ""
IF i Then
msgbox i&"筆符合檔案"
else
Newbk.close False
EX: Msgbox "無符合檔案"
End if
End Sub

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)