返回列表 上一主題 發帖

請求改良程式

請求改良程式

未命名.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)

回復 34# quickfixer
回復 35# jackyq

謝謝兩位前輩指教
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

本帖最後由 198188 於 2024-4-19 17:47 編輯
回復  Andy2483


    曾經被01的高手指導過,他說少用冒號來連結程式碼,尤其是前面有if的時候
那只是看 ...
quickfixer 發表於 2024-4-17 11:28


謝謝前輩提醒。

TOP

冒號是個硬傷
只有幾種情況下可用
很多人都不知道
都在依樣畫葫蘆

TOP

本帖最後由 quickfixer 於 2024-4-17 11:29 編輯

回復 33# Andy2483


    曾經被01的高手指導過,他說少用冒號來連結程式碼,尤其是前面有if的時候
那只是看起來比較短,對速度沒幫助,可讀性也不好,有時候還會不小心出意外

Sub test()
   
    aa = "andy2483"
    bb = "andy2484"
   
    If aa = bb Then Debug.Print "andy": Debug.Print "cc": Exit Sub
   
    Debug.Print "dd"

End Sub


Sub test1()
   
    aa = "andy2483"
    bb = "andy2484"
   
    If aa = bb Then Debug.Print "andy"
    Debug.Print "cc"
    Exit Sub
   
    Debug.Print "dd"

End Sub

TOP

回復 32# 198188

If (Not A Like "[#]###") Or (IsError(D)) Or (Not Q Like "##?Q") Then MsgBox "資料不符規則1": Exit Sub
'↑如果A變數(字串)其字元排列順序(左至右)不是 #字元開頭連接3個數字,或D變數是錯誤值,或
'Q變數(字串)其字元排列順序(左至右)不是 2個數字開頭連接1個任意字元最後連接 Q字元,
'這3個條件其中一個成立,就跳出提視窗~~,結束程式執行,這是要檢查資料表是否規則正確
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

回復  198188

最近有點忙,請前輩舉出不懂的地方,後學有空會回復 或請另發話題請教前輩們
Andy2483 發表於 2024-4-16 08:55


沒事,不急,等前輩有時間在回復。
暫時是這句
If (Not A Like "[#]###") Or (IsError(D)) Or (Not Q Like "##?Q") Then MsgBox "資料不符規則1": Exit Sub

TOP

回復 30# 198188

最近有點忙,請前輩舉出不懂的地方,後學有空會回復 或請另發話題請教前輩們
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

回復  198188

Option Explicit
Sub Map()
Application.DisplayAlerts = False: Application.ScreenUp ...
Andy2483 發表於 2024-3-22 08:51


前輩,可否給一下這個注釋,有的地方還是看不懂。

TOP

回復 28# Andy2483

未命名.png
2024-3-26 08:14

也一樣,有這個問題。

TOP

        靜思自在 : 原諒別人就是善待自己。
返回列表 上一主題