[發問] 序號(籃號)如何截取某儲存格中後2數

帖子: 199
主題: 22
精華: 0
積分: 233
點名: 226
作業系統: Vista
軟體版本: Office2003
閱讀權限: 20
性別: 男
來自: 高雄
註冊時間: 2020-4-14
最後登錄: 2024-11-22

2023年全勤獎章 2022虎年全勤獎章論壇榮譽勳章論壇贊助勳章

9^#

發表於 2021-6-9 12:51 | 只看該作者

回復 8# samwang
謝謝S大大
完全正確運用
感謝指導謝謝

敏而好學,不恥下問

samwang

大學生 Rank: 4

帖子: 976
主題: 7
精華: 0
積分: 1018
點名: 0
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 50
性別: 男
註冊時間: 2013-4-19
最後登錄: 2024-10-30

8^#

發表於 2021-6-8 13:46 | 只看該作者

回復 6# BV7BW

請再測試看看，謝謝

Sub 派車表_輸入2()
Dim DD, CC$, Arr, Brr, i&, j%, N&, xD
Call 派車表_清除
DD = [D1]: CC = [B1]
If Not IsDate(DD) Then MsgBox "**請輸入日期!!  ": Exit Sub
If CC = "" Then MsgBox "**請輸入[車編]!!  ": Exit Sub
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([工作表2!L1], [工作表2!A65536].End(xlUp))
ReDim Brr(1 To UBound(Arr), 1 To 4)
For i = 2 To UBound(Arr)
If Arr(i, 12) <> DD Or Arr(i, 10) <> CC Then GoTo 101
PNo = Arr(i, 11): If xD(PNo) = 1 Then GoTo 101
xD(PNo) = 1:  N = N + 1
If InStr(Arr(i, 2), "S") Then
      Brr(N, 2) = Mid(Split(Arr(i, 2), "-")(1), 1, Len(Split(Arr(i, 2), "-")(1)) - 1)
Else
      Brr(N, 2) = Split(Arr(i, 2), "-")(1)
End If
Brr(N, 1) = Arr(i, 1)
Brr(N, 3) = Arr(i, 2)
Brr(N, 4) = Arr(i, 11)
101: Next i
If N = 0 Then MsgBox "**沒有符合的資料!!  ": Exit Sub
With Sheets("工作表1")
   .[A3].Resize(N, UBound(Brr, 2)) = Brr
   .Range("A1:G" & N + 3).Name = "'" & .Name & "'!Print_Area"
   .Range("1:3").Name = "'" & .Name & "'!Print_Titles"
End With
End Sub

n7822123

　暱稱: 阿龍

帖子: 406
主題: 8
精華: 0
積分: 453
點名: 0
作業系統: WINDOWS 7
軟體版本: 2007
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2015-2-7
最後登錄: 2021-7-31

7^#

發表於 2021-6-8 13:11 | 只看該作者

回復 1# BV7BW

這一串有點混亂，我還是以1樓需求來看就好，修改"派車表_輸入"這個程序

如何將序號(籃號)B2改為截取C2最後2數為序號(籃號)
將籃號(序號)(B欄)更改以編號(C欄)後2位數
如後面有S則以S前2位數

不一樣的地方我也用紅色標注

Sub 派車表_輸入()
Dim DD, CC$, Arr, Brr, i&, j%, N&, xD
Call 派車表_清除
DD = [D1]: CC = [B1]
If Not IsDate(DD) Then MsgBox "**請輸入日期!!  ": Exit Sub
If CC = "" Then MsgBox "**請輸入[車編]!!  ": Exit Sub
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([工作表2!L1], [工作表2!A65536].End(xlUp))
ReDim Brr(1 To UBound(Arr), 1 To 4)
For i = 2 To UBound(Arr)
If Arr(i, 12) <> DD Or Arr(i, 10) <> CC Then GoTo 101
PNo = Arr(i, 11): If xD(PNo) = 1 Then GoTo 101
xD(PNo) = 1
N = N + 1
For j = 1 To 4
      Brr(N, 1) = Arr(i, 1)
      SS$ = Replace(Arr(i, 2), "S", "")
      Brr(N, 2) = Right(SS, 2)
      Brr(N, 3) = Arr(i, 2)
Next j
Brr(N, 4) = Arr(i, 11)
101: Next i
If N = 0 Then MsgBox "**沒有符合的資料!!  ": Exit Sub
With Sheets("工作表1")
   .[A3].Resize(N, UBound(Brr, 2)) = Brr
   .Range("A1:G" & N + 3).Name = "'" & .Name & "'!Print_Area"
   .Range("1:3").Name = "'" & .Name & "'!Print_Titles"
End With
Columns("B").NumberFormatLocal = "00"
End Sub

程式是依需求寫的，需求表達不清楚
或者沒有上傳附件，愛莫能助

帖子: 199
主題: 22
精華: 0
積分: 233
點名: 226
作業系統: Vista
軟體版本: Office2003
閱讀權限: 20
性別: 男
來自: 高雄
註冊時間: 2020-4-14
最後登錄: 2024-11-22

2023年全勤獎章 2022虎年全勤獎章論壇榮譽勳章論壇贊助勳章

6^#

發表於 2021-6-8 09:21 | 只看該作者

回復 2# samwang
S大大你好
經測試後有個問題請問
原本是以If InStr(Arr(i, 2), "A") Then 及 Brr(N, 2) = Format(Right(Arr(i, 2), 2), "00")
改以If InStr(Arr(i, 2), "籃") Then 及 Brr(N, 2) = Format(Right(Arr(i, 2), 4), "00")後
可出現"籃A11".可以運用
但不知改 Brr(N, 2) = Format(Mid(Right(Arr(i, 2), 3), 1, 2), "00")之哪裡
才可出現籃AS00

派車表序號修訂.zip (42.33 KB) 請示指教謝謝

敏而好學,不恥下問

帖子: 199
主題: 22
精華: 0
積分: 233
點名: 226
作業系統: Vista
軟體版本: Office2003
閱讀權限: 20
性別: 男
來自: 高雄
註冊時間: 2020-4-14
最後登錄: 2024-11-22

2023年全勤獎章 2022虎年全勤獎章論壇榮譽勳章論壇贊助勳章

5^#

發表於 2021-6-7 06:25 | 只看該作者

回復 4# hcm19522
謝謝 hcm 先進前輩
堤供資訊.實用可循謝謝

敏而好學,不恥下問

hcm19522

大學生 Rank: 4

帖子: 1387
主題: 4
精華: 0
積分: 1397
點名: 0
作業系統: WIN
軟體版本: 2007
閱讀權限: 50
性別: 男
註冊時間: 2015-9-11
最後登錄: 2024-11-22

熱烈參與勳章

4^#

發表於 2021-6-5 10:00 | 只看該作者

參考
https://blog.xuite.net/hcm19522/twblog/589814048

google"EXCEL迷" blog 或google網址:https://hcm19522.blogspot.com/

帖子: 199
主題: 22
精華: 0
積分: 233
點名: 226
作業系統: Vista
軟體版本: Office2003
閱讀權限: 20
性別: 男
來自: 高雄
註冊時間: 2020-4-14
最後登錄: 2024-11-22

2023年全勤獎章 2022虎年全勤獎章論壇榮譽勳章論壇贊助勳章

3^#

發表於 2021-6-4 19:51 | 只看該作者

[b 復 2# samwang
謝謝 S大大
我先測試運用在向你報告
謝謝

敏而好學,不恥下問

samwang

大學生 Rank: 4

帖子: 976
主題: 7
精華: 0
積分: 1018
點名: 0
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 50
性別: 男
註冊時間: 2013-4-19
最後登錄: 2024-10-30

2^#

發表於 2021-6-4 19:45 | 只看該作者

本帖最後由 samwang 於 2021-6-4 19:48 編輯

回復 1# BV7BW

請測試看看，不知是否為您的需求，謝謝。

Sub 派車表_輸入1()
Dim DD, CC$, Arr, Brr, i&, j%, N&, xD
Call 派車表_清除
DD = [D1]: CC = [B1]
If Not IsDate(DD) Then MsgBox "**請輸入日期!!  ": Exit Sub
If CC = "" Then MsgBox "**請輸入[車編]!!  ": Exit Sub
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([工作表2!L1], [工作表2!A65536].End(xlUp))
ReDim Brr(1 To UBound(Arr), 1 To 4)
For i = 2 To UBound(Arr)
If Arr(i, 12) <> DD Or Arr(i, 10) <> CC Then GoTo 101
PNo = Arr(i, 11): If xD(PNo) = 1 Then GoTo 101
xD(PNo) = 1:  N = N + 1
If InStr(Arr(i, 2), "A") Then
      Brr(N, 2) = Format(Right(Arr(i, 2), 2), "00")
Else
      Brr(N, 2) = Format(Mid(Right(Arr(i, 2), 3), 1, 2), "00")
End If
Brr(N, 1) = Arr(i, 1)
Brr(N, 3) = Arr(i, 2)
Brr(N, 4) = Arr(i, 11)
101: Next i
If N = 0 Then MsgBox "**沒有符合的資料!!  ": Exit Sub
With Sheets("工作表1")
   .[A3].Resize(N, UBound(Brr, 2)) = Brr
   .Range("A1:G" & N + 3).Name = "'" & .Name & "'!Print_Area"
   .Range("1:3").Name = "'" & .Name & "'!Print_Titles"
End With
End Sub