返回列表 上一主題 發帖

[發問] 派車表_撥亂轉正

回復 3# samwang

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

TOP

本帖最後由 軒云熊 於 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
複製代碼

TOP

回復 2# BV7BW


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

TOP

各位先進 老師 大家好
上詢提問解說有些不清楚.現加予重整
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碼數字大小順序重新整合排列
敏而好學,不恥下問

TOP

        靜思自在 : 滴水成河。粒米成蘿,勿輕己靈,勿以善小而不為。
返回列表 上一主題