返回列表 上一主題 發帖

請求改良程式

回復 10# Andy2483

12.png
2024-3-20 08:54
14.png
2024-3-20 08:54


沒有上箱,下箱 複製上錯誤。 全部都是“上架”,“中箱”,“下架”。
我將Sheet1 & Map 相對的數據,貼在上面同一個圖片,並加入注釋,以便清晰了解。
如果同一個儲存格内有兩個數據,分辨困難的話,可以忽略,將它當作一個數據來做

一個儲存格内有兩個數據,第兩個數據會分開并列,如下。
W105  AA工程FC116   1幅
#2311200805 (VP工程5F栏杆玻璃)=1p

W105   AA工程FC116   1幅
2311200805  VP工程5F栏杆玻璃=1p

如果上面效果分辨困難,就當作一個數據操作,其餘的手動修改,如下:
W105  AA工程FC116   1幅
#2311200805 (VP工程5F栏杆玻璃)=1p

W105   AA工程FC116   1幅       #2311200805 VP工程5F栏杆玻璃=1p

TOP

回復 11# 198188


請上傳完整有規則的範例
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

回復 12# Andy2483


以“Sheet1“ 工作表 欄A來為依據, 用MAP模板分拆不同Sheet
取欄A 以 “#” 開始到第一個空格來命名Sheet Name, 及錄入“B3”儲存格内
Sheet Name空格后的日期,錄入到Map “i3”儲存格内
日期后的45HQ, 40HC, 40GP, 40OT, 40RF, 20GP, 錄入到Map“F3”儲存格内
Map“M4”儲存格内 = TODAY


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

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

對應數據的規則
欄位規則對應:
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  ,如上
如此類推

如果欄位内一個儲存格内有兩組或以上數據。
一個儲存格内有兩個數據,第兩個數據會分開并列,如下。
W105  AA工程FC116   1幅
#2311200805 (VP工程5F栏杆玻璃)=1p

W105   AA工程FC116   1幅
2311200805  VP工程5F栏杆玻璃=1p

如果上面效果分辨困難,就當作一個數據操作,其餘的手動修改,如下:
W105  AA工程FC116   1幅
#2311200805 (VP工程5F栏杆玻璃)=1p

W105   AA工程FC116   1幅       #2311200805 VP工程5F栏杆玻璃=1p

列位規則對應:

Sheet1 該組的第一列  對應 MAP 列6 "上架"
Sheet1 該組的第二列  對應 MAP 列7 "下架"

Sheet1 該組的第三列 (或者第三行 至 尾三行)  
舉例Sheet1,
如果總共6列,第3,4列 對應 MAP 列8 "中箱"; 第3,4列的分拆欄位數據錄入同一個相對應的欄位

如果總共7列,第3,4,5列 對應 MAP 列8 "中箱",第3,4,5列的分拆欄位數據錄入同一個相對應的欄位

如果總共8列,第3,4,5,6列 對應 MAP 列8 "中箱"第3,4,5,6列的分拆欄位數據錄入同一個相對應的欄位

如此類推


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

TOP

回復 7# 198188

謝謝論壇,謝謝各位前輩
後學藉此帖練習VBA,學習方案如下,請前輩參考

Sub Map()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim A, D, Q, i&, N&, C%, j%, B6$, B7$, xM, T$, T0$, T1$, f%, u%, K, cc%
For i = Worksheets.Count To 4 Step -1: Worksheets(i).Delete: Next
With Sheets(2): B6 = .[B6]: B7 = .[B7]: .[6:11].NumberFormat = "@": .[C6].Resize(10, 20).ClearContents: End With:
C = Sheets(1).UsedRange.Columns.Count
For Each xM In Intersect(Sheets(1).UsedRange, Sheets(1).[A:A])
   N = xM.MergeArea.Cells.Count: If N < 6 Or xM = "" Then GoTo M01
   xA = Split(Trim(xM), " ")
   A = "#" & StrReverse(Mid(Val(1 & StrReverse(xA(0))), 2)): D = CDate(xA(1)): Q = xA(UBound(xA))
   If (Not A Like "[#]###") Or (IsError(D)) Or (Not Q Like "##?Q") Then MsgBox "資料不符規則1": Exit Sub
   With Sheets(2).Copy(after:=Worksheets(Sheets.Count)): With ActiveSheet: .Name = A
      If .DrawingObjects.Count > 0 Then .DrawingObjects.Delete
      [B3] = A: [F3] = Q: [I3] = D: [M4] = Date
      For i = 1 To 2
         For j = 2 To C
            T = Replace(Replace(Trim(xM(i, j)), "(", "("), ")", ")")
            If T = "" Then GoTo j01
            If InStr(T, B6) Or InStr(T, B7) Then
               T = Replace(T, " ", ""): If Not T Like "*#(*)*" And T <> "" Then MsgBox "資料不符規則2": Exit Sub
               T0 = Trim(Mid(Split(T, "(")(0), 3)): T1 = "(" & Split(T, "(")(1)
               Cells(5 + i, (j - 1) * 2 + 1) = T0: Cells(5 + i, (j - 1) * 2 + 2) = T1: GoTo j01
            End If
            K = Split(T & Chr(10), Chr(10))
            For cc = 0 To UBound(K) - 1
               f = InStr(K(cc), " ")
               If f = 0 Then T0 = K(cc): T1 = "" Else T0 = Mid(K(cc), 1, f - 1): T1 = Mid(K(cc), f + 1)
               Cells(5 + i, (j - 1) * 2 + 1) = IIf(Cells(5 + i, (j - 1) * 2 + 1) = "", T0, Cells(5 + i, (j - 1) * 2 + 1) & vbLf & T0)
               Cells(5 + i, (j - 1) * 2 + 2) = IIf(Cells(5 + i, (j - 1) * 2 + 2) = "", T1, Cells(5 + i, (j - 1) * 2 + 2) & vbLf & T1)
            Next
j01:     Next
      Next
      For i = 3 To N - 3
         For j = 2 To C
            T = Replace(Replace(Replace(Trim(xM(i, j)), "(", "("), ")", ")"), "(", " (")
            If T = "" Then GoTo j02
            If InStr(T, B6) Or InStr(T, B7) Then
               T = Replace(T, " ", ""): If Not T Like "*#(*)*" And T <> "" Then MsgBox "資料不符規則3": Exit Sub
               T0 = Trim(Mid(Split(T, "(")(0), 3)): T1 = "(" & Split(T, "(")(1)
               Cells(8, (j - 1) * 2 + 1) = IIf(Cells(8, (j - 1) * 2 + 1) = "", T0, Cells(8, (j - 1) * 2 + 1) & vbLf & T0)
               Cells(8, (j - 1) * 2 + 2) = IIf(Cells(8, (j - 1) * 2 + 2) = "", T1, Cells(8, (j - 1) * 2 + 2) & vbLf & T1): GoTo j02
            End If
            f = InStr(T, " "): If f = 0 Then T0 = T: T1 = "" Else T0 = Mid(T, 1, f - 1): T1 = Trim(Mid(T, f + 1))
            Cells(8, (j - 1) * 2 + 1) = IIf(Cells(8, (j - 1) * 2 + 1) = "", T0, Cells(8, (j - 1) * 2 + 1) & vbLf & T0)
            Cells(8, (j - 1) * 2 + 2) = IIf(Cells(8, (j - 1) * 2 + 2) = "", T1, Cells(8, (j - 1) * 2 + 2) & vbLf & T1)
j02:     Next
      Next
      u = 8
      For i = N - 2 To N
         u = u + 1
         For j = 2 To C
            T = Replace(Replace(Trim(xM(i, j)), "(", "("), ")", ")")
            If T = "" Then GoTo j03
            If InStr(T, B6) Or InStr(T, B7) Then
               T = Replace(T, " ", ""): If Not T Like "*#(*)*" And T <> "" Then MsgBox "資料不符規則4": Exit Sub
               T0 = Trim(Mid(Split(T, "(")(0), 3)): T1 = "(" & Split(T, "(")(1)
               Cells(u, (j - 1) * 2 + 1) = T0: Cells(u, (j - 1) * 2 + 2) = T1: GoTo j03
            End If
            K = Split(T & Chr(10), Chr(10))
            For cc = 0 To UBound(K) - 1
               f = InStr(K(cc), " ")
               If f = 0 Then T0 = K(cc): T1 = "" Else T0 = Mid(K(cc), 1, f - 1): T1 = Mid(K(cc), f + 1)
               Cells(u, (j - 1) * 2 + 1) = IIf(Cells(u, (j - 1) * 2 + 1) = "", T0, Cells(u, (j - 1) * 2 + 1) & vbLf & T0)
               Cells(u, (j - 1) * 2 + 2) = IIf(Cells(u, (j - 1) * 2 + 2) = "", T1, Cells(u, (j - 1) * 2 + 2) & vbLf & T1)
            Next
j03:     Next
      Next
   End With: End With
M01: Next
End Sub
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

回復 14# Andy2483


我運行后,在#004卡住了,不知道哪堨X現問題。附上Excel.

另外分割第一欄位 C, E, G, I, K, M,沒有去掉 “ # ”,分割第二欄位D, F, H, J, L, N 沒有去掉 " ( " & " ) "

排 櫃 表.rar (40.43 KB)

TOP

回復 15# 198188


謝謝前輩回復
請自己試著排除問題
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

回復 16# Andy2483

好像是中英文的)問題,實際就不知道是不是。那些有問題的儲存格改了英文的)就沒問題。

另外下面這個功能是否做不到?

分割第一欄位 C, E, G, I, K, M,沒有去掉 “ # ”,分割第二欄位D, F, H, J, L, N 沒有去掉 " ( " & " ) "

下面這些去掉 “(” & “)”
(02F单元)
(02F单元)
(9-12F门散件)
(2-7F栏杆)

下面這些去掉  “ # ”
#2312302239
#2312302236
#2312302240
#2402190275

TOP

回復 17# 198188

Sub TEST_1()
Dim T$
T = "(A(BC)D)"
If T Like "(*)" Then T = Mid(T, 2, Len(T) - 2)
MsgBox T
End Sub
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

回復 18# Andy2483


    加在哪個位置上?

TOP

回復 19# 198188

方案的代碼都是VBA基礎,請試著多了解其意義,加在適當位置
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

        靜思自在 : 知識要用心體會,才能變成自己的智慧。
返回列表 上一主題