麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] 分離單號 [打印本頁]

作者: PJChen 時間: 2021-7-4 23:11 標題: 分離單號

大大好,
E欄的單號,含有2個"-",作為分離基準,單號分離至R、S、T三欄中
T欄單號: 3碼+"-" (不足3碼,前面補0)
S欄單號: 4碼+"-" (不足4碼,前面補0)
R欄單號: 3碼 (不足3碼,前面補0)

ex:
採購單號碼末碼中間碼單號
886-1215-283 283 1215- 886-
872-1305-017 017 1305- 872-
010-0105-547 547 0105- 010-

請問要如何寫這個程式? [attach]33505[/attach]

Sub 分離單號()
Dim xB As Workbook, R&, xD, Arr2, Arr3, Arr4
R = Cells(Rows.Count, "E").End(xlUp).Row
If R <= 2 Then Exit Sub
Set xB = Workbooks("分離單號_Split.xlsx")
With xB.Sheets("北區")
R = .Cells(Rows.Count, 1).End(xlUp).Row - 1
If R > 0 Then arr = Split([E2], "-")
If R > 0 Then Arr2 = Split([E2], "-").Resize(R).Value
If R > 0 Then Arr3 = Split([E2], "-").Resize(R).Value
If R > 0 Then Arr4 = Split([E2], "-").Resize(R).Value
End With
xB.Sheets("北區").[r2].Resize(R).Value = Arr2
xB.Sheets("北區").[s2].Resize(R).Value = Arr3
xB.Sheets("北區").[t2].Resize(R).Value = Arr4
Next
End Sub

複製代碼

作者: singo1232001 時間: 2021-7-5 00:14

Sub aaa()
r = Cells(Rows.Count, "E").End(3).Row

Dim ar
ReDim ar(3 To r, 1 To 3)
For i = 3 To r
x = Cells(i, "e")
If x <> "" Then
If Len(x) - Len(Replace(x, "-", "")) = 2 Then

x0 = Split(x, "-")
ar(i, 1) = "'" & x0(2)
ar(i, 2) = x0(1) & "-"
ar(i, 3) = x0(0) & "-"

End If
End If
Next

Range("r3").Resize(r - 2, 3) = ar
End Sub

作者: n7822123 時間: 2021-7-5 00:31

回復 1# PJChen

看你原本的資料好像沒有需要補"0" 的地方?

Sub 分離單號()
Dim Arr, R&
Arr = Range([E2], [E2].End(4))
If Arr(UBound(Arr), 1) = "" Then Exit Sub '沒資料
Columns("R:T").NumberFormatLocal = "@"
ReDim Brr(1 To UBound(Arr), 1 To 3)
For R = 2 To UBound(Arr)
If Arr(R, 1) Like "*-*-*" Then
Brr(R, 1) = Split(Arr(R, 1), "-")(2)
Brr(R, 2) = Split(Arr(R, 1), "-")(1) & "-"
Brr(R, 3) = Split(Arr(R, 1), "-")(0) & "-"
If Len(Brr(R, 1)) < 3 Then Brr(R, 1) = String(3 - Len(Brr(R, 1)), "0") & Brr(R, 1)
If Len(Brr(R, 2)) < 5 Then Brr(R, 2) = String(5 - Len(Brr(R, 2)), "0") & Brr(R, 2)
If Len(Brr(R, 3)) < 4 Then Brr(R, 3) = String(4 - Len(Brr(R, 3)), "0") & Brr(R, 3)
End If
Next R
[R2].Resize(UBound(Brr), 3) = Brr
End Sub

作者: samwang 時間: 2021-7-5 08:03

回復 1# PJChen

請測試看看，謝謝

Sub test()
Dim Arr, Brr(), a, w$, i&, j%
Columns("R:T").NumberFormatLocal = "@"
Arr = Range([E2], [E2].End(4))
ReDim Brr(1 To UBound(Arr), 1 To 3)
For i = 2 To UBound(Arr)
a = Split(Arr(i, 1), "-")
If UBound(a) < 2 Then GoTo 99
For j = 0 To UBound(a)
      w = Split(Arr(i, 1), "-")(j)
      If j = 0 Then
         If Len(w) < 3 Then Brr(i, 3) = "0" & w & "-" Else Brr(i, 3) = w & "-"
      ElseIf j = 1 Then
         If Len(w) < 4 Then Brr(i, 2) = "0" & w & "-" Else Brr(i, 2) = w & "-"
      ElseIf j = 2 Then
         If Len(w) < 3 Then Brr(i, 1) = "0" & w Else Brr(i, 1) = w
      End If
Next
99: Next
[R2].Resize(UBound(Brr), 3) = Brr
End Sub

作者: PJChen 時間: 2021-7-5 17:34

回復 3# n7822123
回復 2# singo1232001
回復 4# samwang

謝謝三位, 結果都很完美！
請問N大 (n7822123)
能否幫忙解說以下程式紅字? 我對UBound的數字對應很不理解@@
.NumberFormatLocal = "@"
ReDim Brr(1 To UBound(Arr), 1 To 3)
For R = 2 To UBound(Arr)

作者: 准提部林 時間: 2021-7-5 18:57

回復 5# PJChen

ubound(arr) ... 緃向行數...相當于指定範圍的rows.count
ubound(arr,2) ... 橫向欄數...相當于指定範圍的columns.count

for i = 2 to ~~
arr的範圍包含第一行標題, 第一行不須處理, 故從2起始~~

作者: 准提部林 時間: 2021-7-5 19:34

若都是純數字~~
Sub TEST_A1()
Dim Arr, i&, j%, Vr, TR
Arr = Range([g1], [e65536].End(3))
Vr = Array("000-", "0000-", "000")
For i = 3 To UBound(Arr)
TR = Split(Arr(i, 1) & "--", "-")
For j = 0 To 2
      Arr(i - 2, 3 - j) = IIf(IsNumeric(TR(j)), Format(TR(j), Vr(j)), "")
Next j
Next i
With [r3].Resize(UBound(Arr) - 2, 3)
   .NumberFormatLocal = "@"
   .Value = Arr
End With
End Sub

'================================

作者: PJChen 時間: 2021-7-5 20:25

回復 7# 准提部林
好久不見....准大好,
程式運作OK

能否解紅字?
Arr = Range([g1], [e65536].End(3))
另程式中沒有R:T, 為何它能自動置入呢?

作者: n7822123 時間: 2021-7-6 00:29

回復 5# PJChen

定義Brr是個2維陣列，它的1維上界等於Arr陣列的1為上界(Rows)，2維界限是1~3(Columns)

以下這個範例程式可以幫你了解陣列的宣告，以及陣列的界限區間

直接執行就可以了，看訊息並對比程式

Sub Ex()
Dim Arr(1 To 10) '定義一個一維陣列Arr
Str1 = "Arr的界限=" & LBound(Arr) & "~" & UBound(Arr) & vbCrLf & vbCrLf
Dim Brr(2 To 20, 3 To 30) '定義一個二維陣列Brr
Str2 = "Brr的1維界限=" & LBound(Brr, 1) & "~" & UBound(Brr, 1) & vbCrLf
Str3 = "Brr的2維界限=" & LBound(Brr, 2) & "~" & UBound(Brr, 2) & vbCrLf
MsgBox Str1 & Str2 & Str3
End Sub

作者: PJChen 時間: 2021-7-6 00:46

本帖最後由 PJChen 於 2021-7-6 00:56 編輯

回復 9# n7822123

執行後,覺得很抽象@@

作者: singo1232001 時間: 2021-7-6 08:55

回復 10# PJChen

關於抽象的問題解決方式如下
先練習如何操作"新增監看式"
https://www.youtube.com/watch?v=SvUFa37qOXo
7:08秒
或
https://blog.gtwang.org/programming/excel-vba-debug-error-handling/

然後開excel vba
輸入
Sub aa()
Dim ar, ar1
ar = Array(1, 2, 3)
ar1 = Array(1, 2, 3)
ReDim Preserve ar(1 To 3)
ReDim Preserve ar1(2 To 4)

Debug.Print ar(1)
Debug.Print ar1(1) '<--此行會出錯正常請繼續看下去
End Sub

1.注意監看式 ar ,ar1的差別請將左前方的 " 田 " 字符號點開並判斷兩者空間編號的不同
2.是否ar1(1) 出現陣列超過範圍代表沒有ar1(1)的位置
修改為ar1(2) 是否正常

另外可以試著加入
ar2=array(1,2,3)
redim Preserve ar2( 3)
會發現跟 redim Preserve ar( 1 to 3) 不一樣
因為
redim Preserve ar2( 3)
是縮寫
原始正確的寫法是
redim Preserve ar2(0 to 3)

結論:經過大量的使用經驗反饋建議剛接觸者者盡量多嘗試 0 to n的寫法,
由於陣列的區域設置大小(n to n)用法很容易與儲存格欄列位號碼搭配迴圈搭配
後續可以減少許多微調的步驟也會較為工整直觀

若還是有疑惑 google 關鍵字"redim 1 to n 用法"

作者: Andy2483 時間: 2023-11-30 10:47

回復 7# 准提部林

謝謝論壇,謝謝前輩指導
後學藉此帖學到順迴圈裡逆著跑結果,這是後學這庸才從沒想過的,學習心得如下,請前輩再指導
執行前:
[attach]37085[/attach]

執行結果:
[attach]37086[/attach]

Option Explicit
Sub TEST_A1()
Dim Arr, i&, j%, Vr, TR
'↑宣告變數
Arr = Range([g1], [e65536].End(3))
'↑令Arr變數是二維陣列,以儲存格值帶入
Vr = Array("000-", "0000-", "000")
'↑令Vr變數是一維陣列
For i = 3 To UBound(Arr)
'↑設順迴圈i
TR = Split(Arr(i, 1) & "--", "-")
'↑令TR變數是一維陣列: Arr陣列值連接"--"成為新字串後,再以"-"分割該字串成
'(索引號至少會有0~2)
For j = 0 To 2
'↑設順迴圈j
      Arr(i - 2, 3 - j) = IIf(IsNumeric(TR(j)), Format(TR(j), Vr(j)), "")
   '↑令原來的Arr陣列值從第1列開始寫入新陣列值
      'IIf():如果IsNumeric(TR(j))邏輯值是True,就回傳 Format(TR(j), Vr(j))字串,
      '否則回傳空字元
      'IsNumeric(TR(j)):TR陣列的j迴圈數索引號陣列值是不是數值?? 回傳True 或 False
      'Format(TR(j), Vr(j)):令TR陣列的j迴圈數索引號陣列值轉化成
      'Vr陣列的j迴圈數索引號陣列值規則的格式字串
Next j
Next i
With [r3].Resize(UBound(Arr) - 2, 3)
'↑以下是關於[R3]儲存格擴展所需範圍儲存格的程序
   .NumberFormatLocal = "@"
   '↑令該範圍儲存格格式是文字
   .Value = Arr
   '↑令該範圍儲存格值以Arr陣列值帶入
End With
End Sub

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