帖子: 12
主題: 6
精華: 0
積分: 19
點名: 0
作業系統: window 7
軟體版本: Excel 2013
閱讀權限: 10
註冊時間: 2015-7-15
最後登錄: 2022-2-2

論壇榮譽勳章論壇贊助勳章

1^# 跳轉到 » 正序看帖

字體大小: tT

發表於 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點開始我就不懂了。

由於親提(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個問題是飾選時，因為我是錄制的，指令出了一句

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

複製代碼

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

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

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

新增資料夾.rar (94.95 KB)

樓主熱帖

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-23

5^#

發表於 2016-4-9 09:48 | 只看該作者

回復 3# tc1701

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

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

4^#

發表於 2016-4-9 05:41 | 只看該作者

回復 3# tc1701

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

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

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

TOP

tc1701

小學生 Rank: 1

帖子: 12
主題: 6
精華: 0
積分: 19
點名: 0
作業系統: window 7
軟體版本: Excel 2013
閱讀權限: 10
註冊時間: 2015-7-15
最後登錄: 2022-2-2

論壇榮譽勳章論壇贊助勳章

3^#

發表於 2016-4-9 01:29 | 只看該作者

回復 2# 准提部林

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

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

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

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-23

2^#

發表於 2016-4-2 11:12 | 只看該作者

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

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

Sub 載入()
Dim Arr, xB As Workbook, BKN, i&, N&, xD, U
Call 清除
Set xD = CreateObject("Scripting.Dictionary") '字典檔
Application.ScreenUpdating = False
Set xB = Workbooks.Open(ThisWorkbook.Path & "\Christy珠寶更新.xls", ReadOnly:=True) '唯讀開啟檔案
Arr = Range(xB.Sheets(1).[C1], xB.Sheets(1).Cells(Rows.Count, 2).End(xlUp)) '將資料範圍納入陣列
xB.Close 0 '關閉檔案
For i = 2 To UBound(Arr)
If Left(Arr(i, 1), 2) = "FJ" Or Left(Arr(i, 1), 1) = "W" Then '檢查編號首2或1英文碼
N = N + 1 '符合者累加1
Arr(N, 1) = Left(Arr(i, 1), 6) & "-" & Right(Arr(i, 1), 3) '寫入編號
Arr(N, 2) = Arr(i, 2) '寫入數量
xD(Arr(N, 1)) = Arr(N, 2) '以編號為key,將數量納入字典檔
End If
Next i
If N > 0 Then Cells(Rows.Count, "H").End(xlUp)(2).Resize(N, 2) = Arr '載入陣列內容
For Each BKN In Array("F珠寶上落牌", "W珠寶上落牌") '逐一開啟兩個檔案
Set xB = Workbooks.Open(ThisWorkbook.Path & "\" & BKN & ".xls", ReadOnly:=True) '唯讀開啟檔案
Arr = xB.Sheets(1).UsedRange '將資料範圍納入陣列
xB.Close 0 '關閉檔案
N = 0 '計數器歸0
For i = 2 To UBound(Arr)
If Left(Arr(i, 5), 2) = "FJ" Or Left(Arr(i, 5), 1) = "W" Then '檢查編號首2或1英文碼
N = N + 1 '符合者累加1
Arr(N, 1) = Left(Arr(i, 5), 6) & "-" & Right(Arr(i, 5), 3) '寫入編號
Arr(N, 2) = Arr(i, 12) '寫入[是/否]
Arr(N, 3) = Val(xD(Arr(N, 1))) '寫入數量(從字典檔中取出)
'↓上/下牌檢查
Arr(N, 4) = ""
If Arr(N, 2) = "否" And Arr(N, 3) > 0 Then Arr(N, 4) = "▲上牌": U = U + 1
If Arr(N, 2) = "是" And Arr(N, 3) = 0 Then Arr(N, 4) = "▼下牌": U = U + 1
End If
Next i
If N > 0 Then Cells(Rows.Count, "C").End(xlUp)(2).Resize(N, 4) = Arr '載入陣列內容
Next
Application.ScreenUpdating = True
If U > 0 Then MsgBox "共有 " & U & " 個項目須處理！　"
End Sub
Sub 清除()
With ActiveSheet
If .FilterMode Then .ShowAllData
.UsedRange.Offset(1, 0).EntireRow.Delete
.[A2].Select
End With
End Sub

複製代碼

　
　
參考檔案：XLS格式，請自行去套

FW珠寶上落牌一鍵.rar (72.71 KB)
　
另一載點：
http://www.funp.net/918457
　
　

TOP