返回列表 上一主題 發帖

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

BV7BW

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

2023年全勤獎章2022虎年全勤獎章論壇榮譽勳章論壇贊助勳章
1# 跳轉到 » 正序看帖
打印
tT
發表於 2021-6-4 11:27 | 只看該作者

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

如何將序號(籃號)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: Arr(N, 2) = Format(N, "00")     '有資料時Arr的第2欄位，自動產生序號
    For j = 1 To 4
        Brr(N, 1) = Arr(i, 1)
        Brr(N, 3) = Arr(i, 2)
        Brr(N, 2) = Arr(N, 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
End Sub
派車表序號修訂.zip (43.86 KB)
收藏 分享
敏而好學,不恥下問

BV7BW

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

2023年全勤獎章2022虎年全勤獎章論壇榮譽勳章論壇贊助勳章
9#
發表於 2021-6-9 12:51 | 只看該作者
回復 8# samwang
謝謝S大大
完全正確運用
感謝指導 謝謝
敏而好學,不恥下問

TOP

samwang

帖子
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

TOP

n7822123
　暱稱: 阿龍

中學生Rank: 2

帖子
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
程式是依需求寫的，需求表達不清楚
或者沒有上傳附件，愛莫能助

TOP

BV7BW

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

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) 請示指教 謝謝
敏而好學,不恥下問

TOP

BV7BW

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

2023年全勤獎章2022虎年全勤獎章論壇榮譽勳章論壇贊助勳章
5#
發表於 2021-6-7 06:25 | 只看該作者
回復 4# hcm19522
謝謝 hcm 先進前輩
堤供資訊.實用可循 謝謝
敏而好學,不恥下問

TOP

hcm19522

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

熱烈參與勳章
4#
發表於 2021-6-5 10:00 | 只看該作者
參考   
https://blog.xuite.net/hcm19522/twblog/589814048
google"EXCEL迷"  blog  或google網址:https://hcm19522.blogspot.com/

TOP

BV7BW

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

2023年全勤獎章2022虎年全勤獎章論壇榮譽勳章論壇贊助勳章
3#
發表於 2021-6-4 19:51 | 只看該作者
[b   復 2# samwang
謝謝 S大大
我先測試運用在向你報告
謝謝
敏而好學,不恥下問

TOP

samwang

帖子
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

TOP

        靜思自在 : 稻穗結得越飽滿，越會往下垂，一個人越有成就，就要越有謙沖的胸襟。
返回列表 上一主題