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

sammyc

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

GBKEE

回復 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

複製代碼

sammyc

先謝謝大大的教導, 但執行後, 同一日期會出現多行

GBKEE

回復 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

複製代碼

sammyc

回復 4# GBKEE

謝謝, 己可決問題,