請高手幫忙，求助VBA包含套用及飾選等指令

tc1701

大家好，小弟最近工作上有一個小難題，就是把三個EXCEL套用到一個EXCEL入面，再把入面的資料經過飾選後得出結果給其他部門使用。

先簡單說明一下步驟:

小弟有4個EXCEL FILE ，分別有  FW珠寶上落牌一鍵(含VBA)、F珠寶上落牌(資料1)、W珠寶上落牌(資料2)、Christy珠寶更新(資料3)

1.要將F珠寶及W珠寶 COPY到 VBA EXCEL上，之後刪除除了商品型號及親提的COLUMN。
2.飾選想刪去不想要的物品，我只想留下FJ字頭及W字頭的ROW，其餘刪掉。
3.由於F及W珠寶上落牌 的編號跟Christy珠寶更新不一樣，意思是例如F珠寶的編號是FJB028000，Christy珠寶更新的編號是FJB028-000，
   所以要把F及W珠寶編號變成跟Christy的編號相同 ( 把編號加上"-")。 所以我會再E2 輸入 =LEFT(C2,6)、F2輸入"-"、G2輸入=RIGHT(C2,3)、H2輸入 =E2&F2&G2、然後套用到最底。
   然後把COLUMN H 的值COPY到 COLUMN C ，最以把所有編號跟Christy一樣了。
4.之後把Chrisy的資料copy到 VBA EXCEL上。然後在H2 輸入 =VLOOKUP(C2,F:G,2,FALSE)，因為F及W編號是公司以來所有的編號，有些已經停產了，但Christy只會賣現有的編號，
    所以F及W編號一定多過Christy編號。

由1-4點我都有VBA做好了(當中有很多都很爛，所以想請高手們幫忙幫忙)。
第5點開始我就不懂了。

下載 (27.61 KB)

2016-4-2 01:46

由於親提(COLUMN D) 顯示是/否 ，意思是有上牌及沒有上牌的意思。
但Christy 的更新表會顯然該貨品有沒有更新。
5.假如 FJB001-047        否  ，Christy 顯示#N/A 或者 0 ，意思就是本身該編號沒有上牌，而且Christy 的更新顯不#N/A 或 0 ，所以我不用把他上牌。
6.假如FJB001-050        是   , Christy 顯示=>1 ，意思是本身該編號有上牌，而且Christy的更新顯示=>1 ，所以我不用把他下牌。

到這兒，我想請高手幫忙教一下弄個VBA 一鍵跟我說有沒有東西要上牌，有沒有東西要下牌的MESSAGE BOX ，MESSAGE BOX 跟使用者說什麼產品要上牌，什麼產品要下牌。

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

至於1-4 點，
我在飾選刪除 ROW時，是固定刪除某幾個ROW，因為如果只顯示SJ，假如有10個，第一個SJ不是由ROW 2 開始，可能由第100個開始，我就不知道怎樣把第100個設為一個變數，但第10個我就懂怎樣設為變數。
所以如果F及W珠寶有新東西加入時，我又要修改。所以請高手們教一教怎樣設第一個SJ為變數。

第2個問題是飾選時，因為我是錄制的，指令出了一句

1. ActiveWorkbook.Worksheets("工作表1").AutoFilter.Sort.SortFields.Clear
   
2.     ActiveWorkbook.Worksheets("工作表1").AutoFilter.Sort.SortFields.Add Key:=Range( _
   
3.         "C1:C629"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
   
4.         xlSortNormal

複製代碼

下載 (16.89 KB)

2016-4-2 01:38

但我停止了指令，之後再按一次又繼續了。


第3個問題是結束做完了，想儲存時，就彈上了這個

下載 (22.24 KB)

2016-4-2 01:40

這個一定要大工程，可能大家繼續我坐下來隨便打幾個文字就有VBA用，
但由1-4 點，我快用了3天時間了，我對VBA不熟悉但我真的很用心去做，但知識不多，所以才想高手們指教一下。
真的希望大家可以幫到我，十分感激，或者可以教小弟做。真的十分感激。謝謝!!

准提部林

第５點需求不太清楚，先試看看：

1. Sub 載入()
   
2. Dim Arr, xB As Workbook, BKN, i&, N&, xD, U
   
3. Call 清除
   
4. Set xD = CreateObject("Scripting.Dictionary") '字典檔
   
5. Application.ScreenUpdating = False
   
6. 
   
7. Set xB = Workbooks.Open(ThisWorkbook.Path & "\Christy珠寶更新.xls", ReadOnly:=True) '唯讀開啟檔案
   
8. Arr = Range(xB.Sheets(1).[C1], xB.Sheets(1).Cells(Rows.Count, 2).End(xlUp)) '將資料範圍納入陣列
   
9. xB.Close 0 '關閉檔案
   
10. For i = 2 To UBound(Arr)
    
11.     If Left(Arr(i, 1), 2) = "FJ" Or Left(Arr(i, 1), 1) = "W" Then '檢查編號首2或1英文碼
    
12.        N = N + 1 '符合者累加1
    
13.        Arr(N, 1) = Left(Arr(i, 1), 6) & "-" & Right(Arr(i, 1), 3) '寫入編號
    
14.        Arr(N, 2) = Arr(i, 2) '寫入數量
    
15.        xD(Arr(N, 1)) = Arr(N, 2) '以編號為key,將數量納入字典檔
    
16.     End If
    
17. Next i
    
18. If N > 0 Then Cells(Rows.Count, "H").End(xlUp)(2).Resize(N, 2) = Arr '載入陣列內容
    
19. 
    
20. 
    
21. For Each BKN In Array("F珠寶上落牌", "W珠寶上落牌") '逐一開啟兩個檔案
    
22.     Set xB = Workbooks.Open(ThisWorkbook.Path & "\" & BKN & ".xls", ReadOnly:=True) '唯讀開啟檔案
    
23.     Arr = xB.Sheets(1).UsedRange '將資料範圍納入陣列
    
24.     xB.Close 0 '關閉檔案
    
25.     N = 0 '計數器歸0
    
26.     For i = 2 To UBound(Arr)
    
27.         If Left(Arr(i, 5), 2) = "FJ" Or Left(Arr(i, 5), 1) = "W" Then '檢查編號首2或1英文碼
    
28.            N = N + 1 '符合者累加1
    
29.            Arr(N, 1) = Left(Arr(i, 5), 6) & "-" & Right(Arr(i, 5), 3) '寫入編號
    
30.            Arr(N, 2) = Arr(i, 12) '寫入[是/否]
    
31.            Arr(N, 3) = Val(xD(Arr(N, 1))) '寫入數量(從字典檔中取出)
    
32.            '↓上/下牌檢查
    
33.            Arr(N, 4) = ""
    
34.            If Arr(N, 2) = "否" And Arr(N, 3) > 0 Then Arr(N, 4) = "▲上牌": U = U + 1
    
35.            If Arr(N, 2) = "是" And Arr(N, 3) = 0 Then Arr(N, 4) = "▼下牌": U = U + 1
    
36.         End If
    
37.     Next i
    
38.     If N > 0 Then Cells(Rows.Count, "C").End(xlUp)(2).Resize(N, 4) = Arr '載入陣列內容
    
39. Next
    
40. 
    
41. Application.ScreenUpdating = True
    
42. If U > 0 Then MsgBox "共有 " & U & " 個項目須處理！　"
    
43. End Sub
    
44. 
    
45. Sub 清除()
    
46. With ActiveSheet
    
47.     If .FilterMode Then .ShowAllData
    
48.     .UsedRange.Offset(1, 0).EntireRow.Delete
    
49.     .[A2].Select
    
50. End With
    
51. End Sub

複製代碼

　
　
參考檔案：XLS格式，請自行去套
FW珠寶上落牌一鍵.rar (72.71 KB)

下載次數: 13

2016-4-2 11:12

　
另一載點：
http://www.funp.net/918457
　
　

tc1701

回復 2# 准提部林



版大你好，最近都沒時間上線，這個程式真是神。有說明非常好,,,
可惜我一句也不明白..不是我懶..而是真的太深奧..
版大方便有天可以詳細解釋一下嗎?
因為我想利用這個程式碼套用其他EXCEL用於工作上，而且我想了解了，而跟同事們解釋一下，不想他們只會按而不去學。

肯教的真的會十分感激!!

原來我一直回覆錯帖子= ="沒有馬上感謝實在抱歉!!

GBKEE

回復 3# tc1701

可惜我一句也不明白..不是我懶..而是真的太深奧..

不是你懶..也不是深奧. 是要費時間去親近它,才會認識它,喜歡它.

准提部林

回復 3# tc1701


如超版所言, 一切需要時間
--- 必須真正有心花時間去找資料, 買書, 看excel內建說明檔,
還沒有vba基本認識, 說太多也是沒多大用處, 霧裡看花,
就像外國人未學拼音或注音, 很難跟他解釋語文, 每一句都如文言文的難懂,
有了基礎, 那我所寫的程式, 看起來就是白話文, 一個說明都不用!!!