返回列表 上一主題 發帖

請求改良程式

請求改良程式

未命名.png
2024-3-13 17:53

請求改良程式:
下面程式有下面問題:
1) 如果Sheet1在 B欄沒有資料的,後面C欄-F欄資料都不會顯示出來。
2)原設計沒有中箱一行
3)資料庫輸入有時會有微改

現想修改比較簡單的規則,只修改圖片部分的規則。
圖片下方是資料庫,每個都固定有5行,但不固定欄數
左上圖為固定模板,按照下方資料庫的位置,排入固定模板。

分割兩欄,
如果有"SR" , 第一欄抽取SR開始到 "(" 或者  ” “ 空格;   
如果沒有"SR" ,第一欄抽取從第一個字到 ” “ 空格;   
舉例
"下架 SR1106(15F单元)" 抽取 "SR1106"   
"SR02 SM-057-094S (T-bolt螺丝垫片)" 抽取 "SR02"
"#2312302240 門框玻璃 280MM =4PCS"  抽取 "#2312302240"
"W001 (OT3工程门玉玻璃GL1-008)" 抽取 "W001"

第二欄抽取第一欄抽取后的所有資料,如果頭尾是“(”“)”就去掉
舉例
"下架 SR1106(15F单元)" 抽取 "15F单元"   
"SR02 SM-057-094S (T-bolt螺丝垫片)" 抽取 "SM-057-094S (T-bolt螺丝垫片"
"#2312302240 門框玻璃 280MM =4PCS"  抽取 "門框玻璃 280MM =4PCS"
"W001 (OT3工程门玉玻璃GL1-008)" 抽取 "OT3工程门玉玻璃GL1-008"

Sub Map()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim Brr, Crr, Ar, Arr, V, Z, A, i&, r&, C%, j%, T$, K$, Qs$, Qd$, No$, Mk$, Q$
For i = Worksheets.Count To 4 Step -1: Worksheets(i).Delete: Next
Set Z = CreateObject("Scripting.Dictionary")
Brr = Union(Sheets(1).UsedRange, Sheets(1).UsedRange.Offset(1))
Crr = Range(Sheets(2).[A1], Sheets(2).UsedRange): K = [B1]
For i = 1 To UBound(Brr) - 1
   If InStr(Brr(i, 1), Left(K, 4)) = 0 Then GoTo i01
   A = Split(Replace(Brr(i, 1), "  ", " "), " "): Q = Mid(A(0), 5, 4): Qd = A(1)
   If UBound(A) > 1 Then Qs = A(UBound(A)) Else Qs = ""
   A = Z(Q): r = Z(Q & "/r"): C = 1
   If Not IsArray(A) Then A = Crr: A(3, 2) = Q: A(3, 6) = Qs: A(3, 9) = Qd: A(4, 13) = Date: r = 5
   r = r + 1: V = A(r, 2)
   If InStr(Brr(i, 2), V) = 0 Or r = 10 Then GoTo i01
   For j = 2 To UBound(Brr, 2)
      C = C + 2: T = Trim(Brr(i, j)): If T = "" Then GoTo j01
      If InStr(T, V) Then
         A(r, C) = Mid(T, 4, 6): A(r, C + 1) = Replace(Mid(T, 11), ")", "")
         Else
         Ar = Split(T, Chr(10))
         For Each Arr In Ar
            If Not Split(Arr & " ", " ")(1) Like "[A-z][A-z]" Then GoTo j01
            No = No & Chr(10) & Split(Arr, " ")(0)
            Mk = Mk & Chr(10) & Mid(Arr, InStr(Arr, Split(Arr, " ")(1)))
         Next
         A(r, C) = Mid(No, 2): A(r, C + 1) = Mid(Mk, 2): No = "": Mk = ""
      End If
j01: Next
   Z(Q) = A: Z(Q & "/r") = r
i01: Brr(i + 1, 1) = IIf(Brr(i + 1, 1) = "", Brr(i, 1), Brr(i + 1, 1))
Next
If Z.Count = 0 Then Exit Sub
For Each A In Z.KEYS
   If Not IsArray(Z(A)) Then GoTo A01
   With Sheets(2).Copy(after:=Worksheets(Sheets.Count))
      ActiveSheet.Name = A
      [A1].Resize(UBound(Z(A)), UBound(Z(A), 2)) = Z(A)
   End With
A01: Next
Application.Goto Sheets(1).[A1]
End Sub

BH#001-004 排 櫃 表.rar (67.69 KB)

回復 1# 198188

這範例檔與之前話題的範例檔資料需要更多判斷才能釐清其為 上架或下架,後學認為資料要進步性
建議前輩多練習,因應這些資料的變化修改程式

20240315_1.jpg
2024-3-15 15:02
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

回復 2# Andy2483

未命名.png
2024-3-15 15:26


原本的程式是分上架 & 下架來分辨。

因爲實際情況調整了,所以改爲 按照改下圖工程内5行來直接分配入上圖的5行内。

而欄位同樣分割兩部分,套入2個欄位, A / B 欄
欄位内的規則有少許改動。
首欄  A:
如果有 "SR", 就抽取 從“SR" 開始計算到下一個 "空格" / "("  
舉例
下架 SR7000 (22F)               => SR7000
上架 SR70 (22F)                   => SR70
下架SR700(2F)                     => SR700
SR12(32F)                             =>SR12
如果沒有"SR", 就抽取第一個字到第一個空格
舉例
W201 (3-10F)                                       =>W201
2312302240 GLASS                           => 2312302240
#2402190275 WING                          =>#2402190275
TENU7325721-1 GLASS                    =>TENU7325721-1

首欄  B:
抽取首欄A之後的字元,如果首尾是”()“就去掉”()“
舉例
W201 (3F-5F單元)                                         =>3F-5F單元
2312302240 GLASS                                      => GLASS
#2402190275 WING                                    =>WING
TENU7325721-1(5-6F水槽)1500*1200    =>  5-6F水槽)1500*1200
下架 SR7000 WINDOW(22F)                                         => WINDOW(22F
上架 SR70 (22F)                                              => 22F
下架SR700 (2F)                                               => 2F
SR12 (32F)                                                       =>32F

TOP

回復 3# 198188

#2312302239 門框玻璃 550MM =11PCS
#2312302236 門框玻璃 300MM =4PCS
#2312302240 門框玻璃 280MM =4PCS
#2402190275 門框玻璃 300MM =4PCS
這些沒辦法判定 上架或 下架
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

回復 4# Andy2483


#2312302239 門框玻璃 550MM =11PCS
#2312302236 門框玻璃 300MM =4PCS
#2312302240 門框玻璃 280MM =4PCS
#2402190275 門框玻璃 300MM =4PCS
下架 SR7006 (07F門玉)
這堿O5行


全部按照資料的順序排列
Sheet1 工作頁 第一行 #2312302239 門框玻璃 550MM =11PCS    等於   MAP 工作頁第6列    最一行的上架
Sheet1 工作頁 第二行 #2312302236 門框玻璃 300MM =4PCS       等於   MAP 工作頁第7列    最二行的下架
Sheet1 工作頁 第三行 #2312302240 門框玻璃 280MM =4PCS      等於    MAP 工作頁第8列    最三行的中箱
Sheet1 工作頁 第四行 #2402190275 門框玻璃 300MM =4PCS      等於    MAP 工作頁第9列    最四行的上架
Sheet1 工作頁 第五行 下架 SR7006 (07F門玉)                                  等於    MAP 工作頁第10列  最五行的下架

不需要根據上架 / 下架來讀取

TOP

本帖最後由 Andy2483 於 2024-3-15 18:42 編輯

回復 5# 198188


    如果超過10項11.12.13....等表又會怎麼變?
與決策者多討論各種不同狀況,手動試行看看
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

本帖最後由 198188 於 2024-3-16 10:16 編輯

回復 6# Andy2483

資料庫1

資料庫1.png
2024-3-16 09:19

資料庫2

資料庫2.png
2024-3-16 09:19

結果1

結果1.png
2024-3-16 09:20

結果2

結果2.png
2024-3-16 09:20

結果3

結果3.png
2024-3-16 09:20



"MAP" 工作表模板固定行數5行 (列6 "上架",列7 "下架",列8 "中箱",列9 "上架",列10 "下架"), 欄位固定從欄C開始,欄數不固定,取決于 "SHEET1"資料庫

"SHEET1" 工作表資料庫,行數最少5行,欄位固定從欄B開始,欄數不固定

對應數據的規則
Sheet1 該組的第一行  對應 MAP 列6 "上架"
Sheet1 該組的第二行  對應 MAP 列7 "下架"

Sheet1 該組的第三行 (或者第三行 至 尾三行)  對應 MAP 列8 "中箱", 如上圖藍色部分
舉例如果總共6行,第3,4行 對應 MAP 列8 "中箱";如果總共7行,第3,4,5行 對應 MAP 列8 "中箱",如果總共8行,第3,4,5,6行 對應 MAP 列8 "中箱",如此類推

Sheet1 該組的尾二行  對應 MAP 列9 "上架"
Sheet1 該組的第尾行  對應 MAP 列10 "下架"

Sheet1 欄B 對應 MAP 欄 C&D, 欄C 抽取 (如有 "SR" ,從"SR"開始 到 第一個空格或者 "(" ;  如沒有"SR" ,從第1個字 到 第一個空格或者 "(" ,並刪除符號 "#" 如有); 欄D 抽取 (欄C 取到的字元之後的所有字元,並刪除符號 "(" & ")" 如有)
Sheet1 欄C 對應 MAP 欄 E&F, 欄E 抽取 (如有 "SR" ,從"SR"開始 到 第一個空格或者 "(" ;  如沒有"SR" ,從第1個字 到 第一個空格或者 "(" ,並刪除符號 "#" 如有); 欄F 抽取 (欄C 取到的字元之後的所有字元,並刪除符號 "(" & ")" 如有)
Sheet1 欄D 對應 MAP 欄 G&H,欄G 抽取 (如有 "SR" ,從"SR"開始 到 第一個空格或者 "(" ;  如沒有"SR" ,從第1個字 到 第一個空格或者 "(" ,並刪除符號 "#" 如有); 欄H抽取 (欄C 取到的字元之後的所有字元,並刪除符號 "(" & ")" 如有)
Sheet1 欄E 對應 MAP 欄 I&J ,如上
Sheet1 欄F 對應 MAP 欄 K&L , 如上
Sheet1 欄G 對應 MAP 欄 M&N , 如上
Sheet1 欄H 對應 MAP 欄 O&P  ,如上
如此類推

排 櫃 表.rar (59.88 KB)

TOP

回復 7# 198188

謝謝前輩回復
這範例的需求還一直在變化需求,建議先手動執行一段時間後,等定案了再以VBA自動化處理
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

回復 8# Andy2483


    #06 是最終的變化了,之前的操作是初步了解。已經經過三個月的測試,才有這個定案。

TOP

回復 9# 198188

謝謝前輩回復
查看了範例,每個櫃子的規則都不相同,自由度非常高,不適合寫程式自動完成
20240320_1.jpg
2024-3-20 07:37


20240320_2.jpg
2024-3-20 07:37
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

        靜思自在 : 有心就有福,有願就有力,自造福田,自得福緣。
返回列表 上一主題