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

標題: [發問] 派車表_撥亂轉正 [打印本頁]

作者: BV7BW 時間: 2021-4-5 20:53 標題: 派車表_撥亂轉正

各位先[進老師大家好
有個2問題請先進老師幫解惑
在工作表1A:D欄中.由編號中前2碼數字大小
轉換成(附件A車.&B車.&C車.&阿宏.&阿一)並加上線框.單號不變
如沒有編號碼就列入最後.如2位相同就並列
1)工作表1需求:可直接由B1做轉換後直接填入.
            客戶1就不用填入籃號1及編號1需加入
   其缺點:是籃號不會因車別而變動.
            易肇成誤投籃筐(A車投入B車).因籃號相同

            或者用2段式轉換
            由B1中去列出資料後.在另行轉換動作.單號不變
            當列出資料後.再去更改籃號後轉換
2)工作表4需求:由"F1"(車編)作基點.並由編號前2碼作順序排列
            也就是說把(A車)&(B車)&(C車)....組合一起
            以編號前2碼大小順序排列
            沒編號者以車編為主.列入該車編之最後.相同編號時並列
如可在程式後加以註解謝謝
  這裡先謝謝各位先進老師們勞心

  [attach]33167[/attach][attach]33167[/attach]

作者: BV7BW 時間: 2021-4-7 08:48

各位先進老師大家好
上詢提問解說有些不清楚.現加予重整
1)工作表1:是以"B1"及"D1".去工作表2中"J1"."L1"比對出.客戶.編號.單號
      並填入工作表1"A3"客戶."C3"編號."D3"單號中.其中"B3"籃號則以有資料自動產生序號
      這是第一階段比對輸入
      第二階段是以第一階段比對後之結果..以(編號)中數字前2碼大小順序.再以重新整合
      並填入"E3"(客戶1)."F3"(籃號1).其中"G3"(編號1)則改為A1數字順序排列
      *(編號1)為何加上"A".本因可用"1"數字順序排列.但因籃號也是以"1"數字.所以再(編號1)中加上"A"作分別*
      *(籃號)是以"A車"籃號最後籃號為"B車"接下順序."C車"為"A車".加上"B車"籃號接下順序.....*
      例如已知"A車"籃號."B車"籃號須用手工去作更改."C車"同樣做法....
      所以須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
結果如下
車編: A車日期: 110年4月1日
客戶    籃號       編號       單號                (客戶1)    (籃號1)    (編號1)
陳一    1          01-A001    1100401001
林二    2          08-A002    1100401002
朱八    3          02-A008    1100401008
傅肯達    4          12-011S    1100401010
胡伯毅    5          11-012S    1100401011
一陳    6          14-A013    1100401012
二林    7          13-A014    1100401013
八朱    8          20-A020    1100401019
達肯傅    9          23-023S    1100401022
毅伯胡    10          24-024S    1100401023
陳一+1    11          26-A025    1100401024
林二+1    12          26-A026    1100401025
傅肯達+1  13    35-035S    1100401029

                                                                              (附件A車)
                                                                                 (客戶1)    (籃號1)       (編號1)
                                                                                       陳一          1                A1
                                                                                       朱八       3             A2
                                                                                       林二       2             A3
                                                                                       胡伯毅       5             A4
                                                                                       傅肯達       4             A5
                                                                                       二林       7             A6
                                                                                       一陳       6             A7
                                                                                       八朱       8             A8
                                                                                       達肯傅       9             A9
                                                                                       毅伯胡       10             A10
                                                                                       陳一+1    11             A11
                                                                                       林二+1    12             A12
                                                                                       傅肯達+1 13             A13

      現工作需求:是將第二階段(重新整合).並填入"E3"(客戶1)"F3"(籃號1)."G3"(編號1)中

第2問題
工作表4中以"F1"(車編)為基點重新整合.並以"B1"(編號)前2碼數字大小順序重新整合排列

作者: samwang 時間: 2021-4-8 11:28

回復 2# BV7BW

很用心看了，但還是不能理解實際需求，看看有無其他大師願意幫忙，謝謝。

作者: 軒云熊 時間: 2021-4-8 18:33

本帖最後由軒云熊於 2021-4-8 18:36 編輯

回復 2# BV7BW

有空幫我試試看是不是你要的 2個結果感謝

Public Sub 從新排列練習()
Application.ScreenUpdating = False
[E65535:G3].ClearContents
For X = 3 To Cells(3, 3).End(4).Row
Cells(X, "E") = Cells(X, "A")
Cells(X, "F") = Cells(X, "B")
Cells(X, "G") = Mid(Cells(X, "C"), 1, 2)
Next X
Range([A65535].End(3), [G3]).Sort [G3], 1, Header:=2
For X = 3 To Cells(3, 3).End(4).Row
Cells(X, "G") = "A" & X - 2
Next X
Range([工作表4!A65535].End(3), [工作表4!J2]).Sort [工作表4!F2], 1, Key2:=[工作表4!B2], Header:=2
Application.ScreenUpdating = True
End Sub

複製代碼

作者: BV7BW 時間: 2021-4-8 19:06

回復 3# samwang

S大大你好
謝謝你
重點是在.第2階段整合排序
也就說當第一階段把"(A車)部分先行整合並列出資料
再行第二階段整合.把第一階段資料重新再次重整.
並以第一階段之編號前2碼數字大小.作為重新整合依據加以排列出
並把編號改為"A1"往下排序
如傳附件.如不詳請再提問
謝謝你S 大大

作者: BV7BW 時間: 2021-4-8 19:08

回復 4# 軒云熊

熊大大你好
謝謝你指導我再演練.後再向你提出報告先謝謝你

作者: BV7BW 時間: 2021-4-8 20:43

回復 4# 軒云熊
剛剛忘先向幾位先進.老師說 "抱歉"
因這2天好去台中出任務.剛開3小時車
回到家剛好6.30分.一時心急.沒第一時間回應.深感抱歉""
在這再向各位先進老師再說""抱歉""

熊大大你好
剛剛演練後有幾個問題
工作表1中.E.F.G欄完全吻合需求.但A.B.C.D欄需要保持不變
其需求原因是工作表1A.C.D欄打單員看.A.B是現場撿貨員看.E.F.G欄是裝車員看
也就是說1表3用
假如A.B.C.D欄更變會造成2員困擾.沒第二轉換造成裝車員不便

工作表1.2.3是單一事件需求
工作表4是單一事件需求
至於工作表4中跟工作表1"E.F.G"欄類式
但工作表4是以"F1"為基點來源
再整面工作表4轉換並依序排列
例
… … … … …  …  …  A車
… … … … …  …  …  A車
… … … … …  …  …  B車
… … … … …  …  …  B車
… … … … …  …  …  C車
… … … … …  …  …  C車

再次謝謝熊大大

作者: 軒云熊 時間: 2021-4-8 20:52

回復 7# BV7BW
抱歉沒注意看
把 Range([A65535].End(3), [G3]).Sort [G3], 1, Header:=2
改成 Range([E65535].End(3), [G3]).Sort [G3], 1, Header:=2 就可以了
順便看一下工作表4 是不是你要的結果感謝

作者: BV7BW 時間: 2021-4-8 20:57

回復 8# 軒云熊

謝謝熊大大
結果完全正確所需要求
如再能把2事件分開?

作者: BV7BW 時間: 2021-4-8 21:01

回復 9# BV7BW[
作者: 軒云熊 時間: 2021-4-8 21:07

回復 9# BV7BW

把 Range([工作表4!A65535].End(3), [工作表4!J2]).Sort [工作表4!F2], 1, Key2:=[工作表4!B2], Header:=2 這行移出來

另外加一個 sub 就可以了
作者: BV7BW 時間: 2021-4-8 21:20

回復 11# 軒云熊

謝謝熊大大
剛剛我也去做這動作...哈真謝謝你

在借這地方
向各位先進.前輩.老師說"謝謝"
去年6月的我從0開始學EXCEL
承蒙准大老師 .J大老師. S大老師熊大老師及各位先進前輩們
詳細指導.真的非常感謝大家.謝謝大家.謝謝
作者: BV7BW 時間: 2021-4-12 11:23

回復 11# 軒云熊
熊大大你好
有幾個問題請教

1)工作表1.當客戶只有1位時.會比對不到.因而會當機

2)工作表4.重整後.可以要在重整回.照客戶編號後2碼大小順序排列.如後碼是S時就排列最後
原本是以客戶前2碼為基點重整..
現需求要重整回以客戶編號後2碼為基點重整
再次謝謝熊大大
作者: samwang 時間: 2021-4-12 15:24

回復 13# BV7BW

1)工作表1.當客戶只有1位時.會比對不到.因而會當機
>> 如下，請測試看看，謝謝
Sub test()
Dim Arr, i&, N%
Application.ScreenUpdating = False
[E65535:G3].ClearContents
With Sheets("工作表1")
With .Range(.[A1], .[D65536].End(3))
      Arr = .Value
      For i = 3 To UBound(Arr)
         N = N + 1
         Arr(N, 1) = Arr(i, 1)
         Arr(N, 2) = Arr(i, 2)
         Arr(N, 3) = Mid(Arr(i, 3), 1, 2)
      Next
      If N > 0 Then
         With .Range("E3").Resize(N, 3)
            .Value = Arr
            .Sort Key1:=.Item(3), Order1:=1, Header:=2
            For i = 1 To N: .Cells(i, 3) = "A" & i: Next
         End With
      End If
End With
End With
Application.ScreenUpdating = True
End Sub

2)工作表4.重整後.可以要在重整回.照客戶編號後2碼大小順序排列....
是這樣嗎?
Range([工作表4!A65535].End(3), [工作表4!J2]).Sort Key1:=[工作表4!B2], Header:=2
作者: BV7BW 時間: 2021-4-12 18:51

回復 14# samwang
謝謝 S大
我先測試後再向你報告
先謝謝你S大大
作者: BV7BW 時間: 2021-4-12 19:14

回復 14# samwang
S大大你好

1)向你報告已完全不會當機
正常運作

2)再向 S 大大說明
1)客戶編號前2碼數字大小進行重整後
要再重新恢復由客戶編號後2碼數字大小排序
如 A001 A002 A003 …最後是有S編號在排序最後
現S大大是以客戶編號前2碼大小排序
我需求是以客戶編號後2碼做排序

再次謝謝 S大大
作者: samwang 時間: 2021-4-12 20:47

回復 16# BV7BW

請問什麼是"客戶編號後2碼"?  有範例嗎?
作者: BV7BW 時間: 2021-4-12 21:00

本帖最後由 BV7BW 於 2021-4-12 21:01 編輯

回復 17# samwang

S大大你好
工作表4剛剛你是以"01-A001"."02-A008.".03-A003....以編號前2碼(01)順序排列
需求是以"01-A001"."08-A002".""03-A003"以編號後(01)後2碼作為順序排列
作者: samwang 時間: 2021-4-12 21:21

回復 18# BV7BW

請再試看看，謝謝
Sub tt()
Dim Arr
With Sheets("工作表4")
With .Range(.[k1], .[a65536].End(3))
      Arr = .Value
      For i = 2 To UBound(Arr)
         If InStr(Arr(i, 2), "A") Then
            Arr(i, 11) = Int(Right(Arr(i, 2), 3))
         Else
            Arr(i, 11) = Int(Mid(Arr(i, 2), 4, 3)) & "s"
         End If
      Next
      .Value = Arr
      .Sort Key1:=.Item(11), Order1:=1, Header:=1
End With
.Range("k1:k" & UBound(Arr)) = ""
End With
End Sub
作者: BV7BW 時間: 2021-4-12 21:29

回復 19# samwang
謝謝 S 大大
正是需求無誤
已可以由編號後2碼整合
在請問.如需用3碼.可再幫程式後加上註解?
** For i = 2 To UBound(Arr)**
作者: samwang 時間: 2021-4-12 21:43

回復 20# BV7BW

Sub tt2()
Dim Arr
With Sheets("工作表4")
With .Range(.[k1], .[a65536].End(3))
      Arr = .Value '資料裝入Arr
      For i = 2 To UBound(Arr)
         If InStr(Arr(i, 2), "A") Then '編號有 A
            Arr(i, 11) = Int(Right(Arr(i, 2), 3)) '取最後3碼的整數，數值裝入Arr(i,11)
         Else
            Arr(i, 11) = Int(Mid(Arr(i, 2), 4, 3)) & "s"  '除了編號A以外的值，取-以後3碼整數+S，數值裝入Arr(i,11)
         End If
      Next
      .Value = Arr 'Arr值貼回excel
      .Sort Key1:=.Item(11), Order1:=1, Header:=1 '以K欄排序
End With
.Range("k1:k" & UBound(Arr)) = "" '清除K欄數值
End With
End Sub
作者: samwang 時間: 2021-4-12 21:47

回復 20# BV7BW

註解已補上，請自行調整運用，有問題再討論，謝謝
作者: BV7BW 時間: 2021-4-12 22:11

回復 22# samwang

謝謝你 S大大
有註解我可再深入理解
再次謝謝你
作者: BV7BW 時間: 2021-4-13 07:25

回復 22# samwang
S大大你好
工作表4中以編號xx-A001.""A""開頭  'If InStr(Arr(i, 2), "A") Then '編號有 A
如以""B""或""C""……..開頭.出現錯誤
現以""A""開頭.只能單一運用
如能加上""B"".""C""……….或者只以編號後3碼作為轉換資料基點.而後3碼有S一樣列在最後
這樣運用變化比較靈活
謝謝你 S 大大
作者: samwang 時間: 2021-4-13 08:24

回復 24# BV7BW

請測試看看，謝謝
Sub tt3()
Dim Arr
With Sheets("工作表4")
   With .Range(.[k1], .[a65536].End(3))
      Arr = .Value '資料裝入Arr
      For i = 2 To UBound(Arr)
         If InStr(Arr(i, 2), "S") Then '編號有 S
               Arr(i, 11) = Int(Mid(Arr(i, 2), 4, 3)) & "s"  '編號S，取-以後3碼整數+S，數值裝入Arr(i,11)
         Else
               Arr(i, 11) = Int(Right(Arr(i, 2), 3)) '除了編號S以外，取最後3碼的整數，數值裝入Arr(i,11)
         End If
      Next
      .Value = Arr 'Arr值貼回excel
      .Sort Key1:=.Item(11), Order1:=1, Header:=1 '以K欄排序
End With
   .Range("k1:k" & UBound(Arr)) = "" '清除K欄數值
End With
End Sub
作者: BV7BW 時間: 2021-4-13 11:40

謝謝 S 大大
目前運作順暢
感謝你勞心賜教謝謝
作者: BV7BW 時間: 2021-4-15 08:12

回復 8# 軒云熊

S 大大你好
車編重整後.編號是由01.順序排列
現需求以A001.B001.C001順序排列
謝謝你勞心
[attach]33206[/attach][attach]33206[/attach]
作者: BV7BW 時間: 2021-4-15 08:16

回復 27# BV7BW
抱歉
熊大大
又把稱號錯亂
作者: 軒云熊 時間: 2021-4-15 11:02

回復 28# BV7BW

甚麼稱號錯亂?
作者: samwang 時間: 2021-4-15 13:43

回復 27# BV7BW

不知道是不是你要的需求，請確認看看，謝謝。
Sub tt4()
Dim Arr
With Sheets("工作表1")
   With .Range(.[k1], .[a65536].End(3))
      Arr = .Value '資料裝入Arr
      For i = 2 To UBound(Arr)
            If InStr(Arr(i, 2), "S") Then '編號有 S
               Arr(i, 11) = Int(Mid(Arr(i, 2), 4, 3)) & "s"  '編號S，取-以後3碼整數+S，數值裝入Arr(i,11)
            Else
               Arr(i, 11) = Int(Right(Arr(i, 2), 3)) '除了編號S以外，取最後3碼的整數，數值裝入Arr(i,11)
            End If
      Next
      .Value = Arr 'Arr值貼回excel
      .Sort Key1:=.Item(6), Order1:=1, _
      Key2:=.Item(11), Order1:=1, Header:=1 '以F、K欄排序
End With
   .Range("k1:k" & UBound(Arr)) = "" '清除K欄數值
End With
End Sub
作者: BV7BW 時間: 2021-4-15 19:25

回復 30# samwang
謝謝  S大大
完全符合重整後編號
再次謝謝你  S 大大你勞心指導
謝謝你
作者: BV7BW 時間: 2021-4-22 05:44

回復 30# samwang
  s大大你好
版本轉到正常使用版本會出現
Arr(i, 11) = Int(Right(Arr(i, 2), 3)) '除了編號S以外，取最後3碼的整數，數值裝入Arr(i,11)
這段錯誤
執行階段錯誤'13'
型態不符合
我改很久.像改儲存格改為文字
一樣不行
請幫解惑謝謝[attach]33229[/attach]
作者: samwang 時間: 2021-4-22 07:09

回復 32# BV7BW

請在試看看，謝謝。

Sub 復整2()
Dim Arr
With Sheets("工作表3")
   With .Range(.[k1], .[a65536].End(3))
      Arr = .Value '資料裝入Arr
      For i = 2 To UBound(Arr)
            If Arr(i, 2) = "" Then GoTo 99  '空白就換下一個
            If InStr(Arr(i, 2), "S") Then '編號有 S
               Arr(i, 11) = Int(Mid(Arr(i, 2), 4, 3)) & "s"  '編號S，取-以後3碼整數+S，數值裝入Arr(i,11)
            Else
               Arr(i, 11) = Int(Right(Arr(i, 2), 3)) '除了編號S以外，取最後3碼的整數，數值裝入Arr(i,11)
            End If
99:    Next
      .Value = Arr 'Arr值貼回excel
      .Sort Key1:=.Item(6), Order1:=1, _
      Key2:=.Item(11), Order1:=1, Header:=1 '以F、K欄排序
End With
   .Range("k1:k" & UBound(Arr)) = "" '清除K欄數值
End With
End Sub
作者: BV7BW 時間: 2021-4-22 14:40

回復 33# samwang
謝謝 s大大
現在轉至正常使用版以非常順暢使用
謝謝你

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