Board logo

標題: 請高手幫忙，求助VBA包含套用及飾選等指令 [打印本頁]
作者: tc1701    時間: 2016-4-2 01:45     標題: 請高手幫忙，求助VBA包含套用及飾選等指令

本帖最後由 tc1701 於 2016-4-2 01:46 編輯

大家好，小弟最近工作上有一個小難題，就是把三個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點開始我就不懂了。

[attach]23683[/attach]
由於親提(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
複製代碼
[attach]23680[/attach]

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


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


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

本帖最後由 准提部林 於 2016-4-2 11:13 編輯

第５點需求不太清楚，先試看看：
  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

  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 '載入陣列內容


  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

  41. Application.ScreenUpdating = True
  42. If U > 0 Then MsgBox "共有 " & U & " 個項目須處理！　"
  43. End Sub

  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格式，請自行去套
[attach]23684[/attach]
　
另一載點：
http://www.funp.net/918457
　
　
作者: tc1701    時間: 2016-4-9 01:29

回復 2# 准提部林



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

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

原來我一直回覆錯帖子= ="沒有馬上感謝實在抱歉!!
作者: GBKEE    時間: 2016-4-9 05:41

回復 3# tc1701
可惜我一句也不明白..不是我懶..而是真的太深奧..

不是你懶..也不是深奧. 是要費時間去親近它,才會認識它,喜歡它.
作者: 准提部林    時間: 2016-4-9 09:48

回復 3# tc1701


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



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