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