Board logo

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

作者: 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個結果 感謝
  1. Public Sub 從新排列練習()
  2. Application.ScreenUpdating = False
  3. [E65535:G3].ClearContents

  4. For X = 3 To Cells(3, 3).End(4).Row
  5.     Cells(X, "E") = Cells(X, "A")
  6.     Cells(X, "F") = Cells(X, "B")
  7.     Cells(X, "G") = Mid(Cells(X, "C"), 1, 2)
  8. Next X
  9. Range([A65535].End(3), [G3]).Sort [G3], 1, Header:=2

  10. For X = 3 To Cells(3, 3).End(4).Row
  11.     Cells(X, "G") = "A" & X - 2
  12. Next X
  13. Range([工作表4!A65535].End(3), [工作表4!J2]).Sort [工作表4!F2], 1, Key2:=[工作表4!B2], Header:=2
  14. Application.ScreenUpdating = True
  15. 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/)