返回列表 上一主題 發帖

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

samwang

帖子
976 
主題
7 
精華
0 
積分
1018 
點名
0  
作業系統
Win10 
軟體版本
Office 2016 
閱讀權限
50 
性別
男 
註冊時間
2013-4-19 
最後登錄
2026-5-26 
1# 跳轉到 »
發表於 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

samwang

帖子
976 
主題
7 
精華
0 
積分
1018 
點名
0  
作業系統
Win10 
軟體版本
Office 2016 
閱讀權限
50 
性別
男 
註冊時間
2013-4-19 
最後登錄
2026-5-26 
2#
發表於 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

        靜思自在 : 難行能行，難捨能捨，難為能為，才能昇華自我的人格。
返回列表 上一主題