Board logo

標題: [發問] 連續數列資料判斷問題 [打印本頁]
作者: cait    時間: 2010-5-11 12:28     標題: 連續數列資料判斷問題

各位大大好
請教關於判斷連續列資料問題，判斷連續編號若日期、班次、車號皆相同
則計算連續次數、連續時間、連續距離，以下面資料為例
編號1116、1117、1118為連續編號，但1118的班次不同
所以僅須計算編號1116、1117的連續次數、連續時間、連續距離
連續次數為2，連續時間為31233-31218=15 [(F2-F1)]，
連續距離為(31233-31218)*52=780 [(F2-F1)*G1]
編號1391、1392、1393為連續編號，且日期、班次、車號皆相同
因此連續次數為3，連續時間為35449-35446=3 [(F6-F4)]，
連續距離為(35449-3448)*57+(35448-35446)*53=163 [(F6-F5)*G5+(F5-F4)*G4]

        A        B        C        D        E        F        G
        編號        日期        班次        車號        時間        時間轉換        速度
1        1116        2010/3/2        801         A        08:40:18        31218        52
2        1117        2010/3/2        801         A        08:40:33        31233        53
3        1118        2010/3/2        802         A        08:46:04        31564        51
4        1391        2010/3/2        901         B        09:50:46        35446        53
5        1392        2010/3/2        901         B        09:50:48        35448        57
6        1393        2010/3/2        901         B        09:50:49        35449        56
7        1436        2010/3/2        901         B        09:58:18        35898        52
8        1542        2010/3/2        901         B        10:17:08        37028        53
9        1543        2010/3/2        901         B        10:17:11        37031        56
10        1544        2010/3/2        901         B        10:17:16        37036        60
11        1545        2010/3/2        901         B        10:17:23        37043        65
12        1546        2010/3/2        901         B        10:17:26        37046        60

希望能夠取得如附件檔案sheet2的結果
請教各位大大應該要如何處理?
如果不用Cells(i,j)方式，還有什麼方式可以處理?
[attach]254[/attach]
作者: Hsieh    時間: 2010-5-11 19:25

回復 1# cait
  1. Sub nn()
  2. Dim Ar(11), Rng As Range, cnt%, r&, A As Range, k%, t1&, s&
  3. Sheet2.Cells = ""
  4. With Sheet1
  5. r = 2: k = 1: ay = Array("班次", "連續次數", "編號", "日期", "班次", "車號", "時間", "時間轉換", "速度", "連續時間", "連續距離")
  6. Do Until r > Application.CountA(.Columns("A"))
  7. cnt = 1: t1 = .Cells(r, 6): s = .Cells(r, 7): Ar(0) = .Cells(r, 3): Set Rng = .Cells(r, 1).Resize(, 7)

  9. Do Until .Cells(r, 1) + 1 <> .Cells(r + 1, 1) Or .Cells(r, 3) <> .Cells(r + 1, 3)
  10. r = r + 1
  11. Set Rng = Union(Rng, .Cells(r, 1).Resize(, 7))
  12. cnt = cnt + 1
  13. Loop
  14. If cnt > 1 Then
  15. If Rng(1, 3) <> Sheet2.Cells(2, k) And Sheet2.[A1] <> "" Then k = k + 12
  16. Ar(1) = cnt
  17. Ar(9) = .Cells(r, 6) - t1
  18. Ar(10) = Ar(9) * s
  19. Sheet2.Cells(1, k).Resize(, 11) = ay
  20. Set A = Sheet2.Cells(65536, k + 2).End(xlUp).Offset(1, 0)
  21. Sheet2.Cells(A.Row, k).Resize(, 11) = Ar
  22. Rng.Copy Sheet2.Cells(A.Row + 1, k + 2)
  23. Erase Ar
  24. End If
  25. r = r + 1
  26. Loop
  27. End With
  28. End Sub
複製代碼
作者: Andy2483    時間: 2022-10-13 09:59

本帖最後由 Andy2483 於 2022-10-13 10:10 編輯

回復 2# Hsieh


    謝謝前輩
題型剛好吻合練習需求!
今天習得:
1.Dim Ar(11)  ←宣告 Ar0~Ar11的變數
2.Sheet2.Cells = "" ←Sheet2=Sheets(2),但不一定Sheet2=Sheets("Sheets2")
3.Application.CountA(.Columns("A"))
3.1.Application.CountA計算儲存格數量,包括錯誤值及空白文字 ("")。 不過，數值不包括空白儲存格
3.2.Columns("A")=Columns("A:A")=[A:A]
4.練習陣列與字典
請前輩再指導!
[attach]35300[/attach]

原始資料:
[attach]35301[/attach]           [attach]35302[/attach]

結果:
[attach]35303[/attach]
作者: Andy2483    時間: 2022-10-13 15:10

本帖最後由 Andy2483 於 2022-10-13 15:19 編輯

謝謝各位前輩4545天以來的參與&分享&奉獻....指導
這論壇很厲害!謝謝論壇團隊!
走過必留足跡!
以下心得分享並懇請再指導!

此練習情境沒有加入同日期的判斷
Option Explicit
Sub 陣列_字典練習()
Application.ScreenUpdating = False
Dim Sh(2), K&, Ay, x, v&, NN
'↑宣告變數 Sh(2):Sh(0)~Sh(2)

Set Sh(1) = Sheet1: Set Sh(2) = Sheet2
'↑令Sh(1)是第一個工作表:令Sh(2)是第二個工作表

Sh(2).UsedRange.EntireRow.Delete
'↑第二個工作表所有使用過的列涵蓋的範圍列刪除

Ay = Split("班次,連續次數,編號,日期,班次,車號,時間,時間轉換,速度,連續時間,連續距離", ",")
'↑令Ay是一維陣列:字串用逗點,切割開倒進去

Dim Arr, Brr(1 To 999, 1 To 12), Crr, xD, i&, j%, T1$, T2&, Tn&, T3%, T4&, TT$, z
Dim N&, xA As Range, Q&, CC&
'↑宣告變數

Set xD = CreateObject("Scripting.Dictionary")
'↑令xD是字典

Arr = Sh(1).Range(Sh(1).Cells(1, 7), Sh(1).Cells(Rows.Count, 1).End(3).Item(2, 1))
'↑令Arr是陣列:表1的G2到A欄最後儲存格範圍的值倒入

For i = 2 To UBound(Arr) - 1
   T1 = Arr(i, 3)
   '↑令T1是 班次
   
   T2 = Arr(i, 1)
   '↑令T2是 編號
   
   T3 = Arr(i, 7)
   '↑令T3是 速度
   
   T4 = Arr(i, 6)
   '↑令T4是 時間轉換
   
   Tn = Arr(i + 1, 1)
   '↑令Tn是 下個編號
   
   TT = T1 & "|" & T2 - Q
   '↑令TT是 班次&"|"&編號 組合的字串
   'Q初始值是0,所以i=1時TT="801|1116"
   
   xD(T2 - Q) = xD(T2 - Q) + 1
   '↑令編號是key,開始item累加 1
   'Q初始值是0,key=1116,item= 0+1 =1
      
   Crr = xD(TT & "/c")
   '↑令Crr到字典裡找key= 班次&"|"&編號&"/c",這組合字串的ITEM
   '因為找不到所以是 無
   
   xD(TT) = xD(TT) + 1
  '↑令班次&"|"&編號組合字串是key,開始item累加 1
   'i=1時TT="801/1116",item= 0+1 =1
   
   If Not IsArray(Crr) And (Tn - T2 = 1) Then
   '↑如果Crr不是陣列 且下一個編號-編號=1
   'i=1時,Crr不是陣列且1117-1116=1 吻合條件
   
      Crr = Brr
      '↑令Crr=Brr這個空陣列
      
      N = N + 1
      '↑令N累加 1,這數字是要當key
      ',N初始值=0,N累加1=1
      
      xD(N) = TT
     '↑i=1時令 數字1 是key,"801|1116"字串是item
      
      If Not xD.Exists(T1) Then
      '↑如果班次在xD字典裡還找不到
      'i=1時 班次 "801" 這字串key還沒有在xD字典裡
      
         K = K + 1
         '↑令K累加 1,這數字是要當item
         ',N初始值=0,K累加1=1
         
         xD(T1) = K
         '↑i=1時令 "801"字串 是key,item=1
         
      End If
      xD(TT & "/速度") = T3
      '↑令i=1時 "801|1116/速度" 字串 是key,item=52 數字
      
      xD(T1 & "/c") = xD(T1 & "/c") + 1
      '↑令i=1時 "801/c" 字串 是key,item累加 1
      
   End If
   If Tn - T2 = 1 Or xD(TT) > 1 Then
  '↑如果下一個編號-這編號=1 或 key是 TT 的item>1
   'Or xD(TT) > 1也要判斷!
   '是因為編號連續的最後一個編號的資料也要倒入Crr陣列裡
   ',否則會漏掉編號連續的最後一個編號的資料
   
      For j = 3 To 9
      '↑設迴圈讓第3 到9欄的資料倒入Crr陣列裡
      
         Crr(xD(TT), j) = Arr(i, j - 2)
      Next j
   End If
   If Tn - T2 = 1 Then
  '↑如果下一個編號-這編號=1
   
      Q = Q + 1
      '↑如果條件成立 Q累加1,這是到下一個i時要給前方扣掉Q!
      '判斷是不是編號連續用的
      
      Else
      '↑如果條件不成立!也是編號不連續的意思
      
         Q = 0
         '↑Q就歸零
         
   End If
   '↑同Q = IIf(Tn - T2 = 1, Q + 1, 0)
   
   
   If Q > 1 Or xD.Exists(TT & "/連續時間") Then
   '↑如果Q(連續編號次數>1 或 xD字典裡有key是 TT & "/連續時間"
   
      xD(TT & "/連續時間") = xD(TT & "/連續時間") + (Arr(i, 6) - Arr(i - 1, 6))
      '↑如果條件成立! key是 TT & "/連續時間"累加 每段的時間
      
   End If
   xD(TT & "/c") = Crr
   '↑令 TT & "/c"這字串當key,item是陣列Crr
   
i01: Next i
'↑迴圈總結就是很累很難!不知道怎麼說了!
'↓創立字典倒入字典 難! 把資料調出字典更難!
For Each z In xD.keys
'↑設迴圈令z是xD字典key裡的一份子,從前面跑到最後

   If z Like "###|####" = False Then
   '↑如果z_key不是 數字數字數字|數字數字數字數字
   
      GoTo 333
      '↑如果條件成立就跳到 333的位置繼續執行
      '因為我們要找 班次&"|"&編號 組合的字串
      
   End If
   If xD(z) = 1 Then
   '↑如果z_item是1
   
      GoTo 333
      '↑如果條件成立就跳到 333的位置繼續執行
      '因為班次&"|"&編號 組合的字串只有1筆的我們也不要
      
   End If
   '↓接下來就要開始佈標題列跟 倒出陣列資料了
   
   T1 = Split(z, "|")(0)
   '↑令T1是符合條件的班次
   
   v = xD(Split(z, "|")(0) & "/c")
  '↑令v是這班次連續過的次數
   
   CC = (xD(T1) - 1) * UBound(Brr, 2) + 1
  '↑令CC是標題列開始倒入的起始欄位位置
   
   NN = 1
   '↑令NN()的起始值是1
   '是標題列開始倒入的起始列位位置1
   
   If NN = 1 And Sh(2).Cells(1, CC) <> "" Then
   '↑如果NN是1 且表2的 標題列已經用過了
   
      GoTo 333
      '↑就跳到 333的位置繼續執行!排除字典裡處裡過的班次
      
   End If
   For Each x In xD.keys
   '↑設迴圈令x是xD字典key裡的一份子,從前面跑到最後
   
      If InStr(x, T1 & "|") = 1 And InStr(x, "/") = 0 Then
     '↑如果x_key 有 T1&"|" 這字串且不包含"/" 字元
      '找班次的意思
      
         If NN = 1 Then
         '↑如果前面找到了班次後!
         '↑如果這時NN = 1
         
            Sh(2).Cells(1, CC).Resize(1, UBound(Ay) + 1) = Ay
            '↑把標題列貼入表2在前方決定的第一列位置
            
            Sh(2).Cells(2, CC) = T1
            '↑標題列位置的下一列第一格放班次
            
            Sh(2).Cells(2, CC + 1) = xD(x)
            '↑標題列位置的下一列第二格放編號連續的次數
            
            Sh(2).Cells(2, CC + 9) = xD(x & "/連續時間")
            '↑標題列位置的下一列第十格放編號連續的累積時間
            
            Sh(2).Cells(2, CC + 10) = xD(x & "/連續時間") * xD(x & "/速度")
            '↑標題列位置的下一列第十一格放編號連續的累積連續距離
            
            NN = 3
            '↑標題列跟統計列處裡完!就讓NN = 3,開始倒入陣列資料
            
            Crr = xD(z & "/c")
            '↑調出陣列
            
            Sh(2).Cells(NN, CC).Resize(UBound(Crr), 11) = Crr
            '↑把Crr陣列貼到表2的相對位置!
            
            NN = NN + xD(x) + 1
            '↑NN要加入陣列列數再加1
            '再加1是給下一個統計列用的
            
            ElseIf xD(x) > 1 Then
            '↑否則NN不是1,而且如果 班次&"|"&編號是有連續的
            
               Sh(2).Cells(NN - 1, CC) = T1
               '↑表2的相對統計列第一格放班次
               
               Sh(2).Cells(NN - 1, CC + 1) = xD(x)
               '↑表2的相對統計列第二格放編號連續的次數
               
               Sh(2).Cells(NN - 1, CC + 9) = xD(x & "/連續時間")
               '↑表2的相對統計列第十格放編號連續的累積時間
               
               Sh(2).Cells(NN - 1, CC + 10) = xD(x & "/連續時間") * xD(x & "/速度")
               '↑表2的相對統計列第十一格放編號連續的累積連續距離
               
               Crr = xD(x & "/c")
               '↑調出陣列
               
               Sh(2).Cells(NN, CC).Resize(UBound(Crr), 11) = Crr
               '↑把Crr陣列貼到表2的相對位置!
               
               NN = NN + xD(x) + 1
               '↑NN要加入陣列列數再加1
               '再加1是給下一個統計列用的
               
         End If
      End If
   Next
   
333
Next
End Sub



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