返回列表 上一主題 發帖

[求助] 將陣列資料篩選, 按條件分列

[求助] 將陣列資料篩選, 按條件分列

本帖最後由 sammyc 於 2011-12-1 16:29 編輯

有一陣列, 內有工號,日期及時間, 如何將其按工號,及日期 再按時段將數據分列排出 ?
ScreenHunter_04 Dec. 01 16.23.jpg

活頁簿5.rar (6.16 KB)

50 字節以內
不支持自定義 Discuz! 代碼

回復 1# sammyc
最後的時間區段 少一個0         214500-223000
   
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Ar(1 To 6), i, ii, F As Boolean
  4.     For i = 1 To 6
  5.         Ar(i) = Split(Range("G3").Cells(1, i), "-")   '讀取時間區段
  6.     Next
  7.     With Range("E2")
  8.     i = 2
  9.         .CurrentRegion.Offset(2).Clear
  10.         Do While Cells(i, "C") <> ""                   '讀取資料
  11.             .Offset(i) = Cells(i, "C")
  12.             .Offset(i, 1) = Cells(i, "A")
  13.             F = True                                    '比較前的變數=True
  14.             For ii = 1 To 6                             '在6段時間裡比較後取得時間區段
  15.                 If Val(Cells(i, "B")) >= Val(Ar(ii)(0)) And Val(Cells(i, "B")) <= Val(Ar(ii)(1)) Then
  16.                     .Offset(i, ii + 1) = Cells(i, "B")
  17.                     F = False                           '有取得時間區段的變數=False
  18.                     Exit For
  19.                 End If
  20.             Next
  21.             If F = True Then .Offset(i, ii + 1) = Cells(i, "B")
  22.             i = i + 1
  23.         Loop
  24.     End With
  25. End Sub
複製代碼

TOP

先謝謝大大的教導, 但執行後, 同一日期會出現多行
ScreenHunter_05 Dec. 01 17.52.jpg
50 字節以內
不支持自定義 Discuz! 代碼

TOP

回復 3# sammyc
抱歉有點眼花沒看清楚題意
更正:
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Ar(), TimeAr(1 To 6), i As Long, ii As Long, R As Integer, F As Boolean
  4.     Ar = Range("A1").CurrentRegion                        '備份資料
  5.     Range("A1").CurrentRegion.Sort Key1:=Range("C2"), Order1:=xlAscending, Key2:=Range("A2"), Order1:=xlAscending, Header:=xlYes  '排序資料
  6.     For i = 1 To 6
  7.         TimeAr(i) = Split(Range("G3").Cells(1, i), "-")   '讀取時間區段加入為TimeAr陣列的元素
  8.     Next
  9.     With Range("E2")
  10.         i = 2                                              '讀取資料列
  11.         R = 2                                              '寫入 gx,date的資料列
  12.         .CurrentRegion.Offset(2).Clear                     '清除 寫入區
  13.         Do
  14.             Do
  15.                 .Offset(R) = Cells(i, "C")                  '寫入 gx
  16.                 .Offset(R, 1) = Cells(i, "A")               '寫入 date
  17.                 F = True                                    '比較前的變數=True
  18.                 For ii = 1 To 6                             '在6段時間裡比較後取得時間區段
  19.                     If Val(Cells(i, "B")) >= Val(TimeAr(ii)(0)) And Val(Cells(i, "B")) <= Val(TimeAr(ii)(1)) Then
  20.                         .Offset(R, ii + 1) = Cells(i, "B")  '數值寫入時間區段
  21.                         F = False                           '有取得時間區段的變數=False
  22.                         Exit For                            '離開迴圈
  23.                     End If
  24.                 Next
  25.                 If F = True Then .Offset(R, ii + 1) = Cells(i, "B")
  26.                 If Cells(i, "A") <> Cells(i + 1, "A") Then R = R + 1     '不同date往下一行
  27.                 i = i + 1
  28.             Loop Until Cells(i, "C") <> Cells(i + 1, "C") Or Cells(i + 1, "C") = ""  '依序讀取資料直到  gx 不相同,或資料為空白
  29.         Loop Until Cells(i, "C") = ""                                                '依序讀取資料迴圈直到資料為空白
  30.     End With
  31.     Range("A1").CurrentRegion = Ar                            '還原資料
  32. End Sub
複製代碼

TOP

回復 4# GBKEE

謝謝, 己可決問題,
50 字節以內
不支持自定義 Discuz! 代碼

TOP

        靜思自在 : 手心向下是助人,手心向上是求人;助人快樂,求人痛苦。
返回列表 上一主題