標題:
[求助] 將陣列資料篩選, 按條件分列
[打印本頁]
作者:
sammyc
時間:
2011-12-1 16:28
標題:
[求助] 將陣列資料篩選, 按條件分列
本帖最後由 sammyc 於 2011-12-1 16:29 編輯
有一陣列, 內有工號,日期及時間, 如何將其按工號,及日期 再按時段將數據分列排出 ?
作者:
GBKEE
時間:
2011-12-1 17:37
回復
1#
sammyc
最後的時間區段 少一個0 214500-22300
0
Option Explicit
Sub Ex()
Dim Ar(1 To 6), i, ii, F As Boolean
For i = 1 To 6
Ar(i) = Split(Range("G3").Cells(1, i), "-") '讀取時間區段
Next
With Range("E2")
i = 2
.CurrentRegion.Offset(2).Clear
Do While Cells(i, "C") <> "" '讀取資料
.Offset(i) = Cells(i, "C")
.Offset(i, 1) = Cells(i, "A")
F = True '比較前的變數=True
For ii = 1 To 6 '在6段時間裡比較後取得時間區段
If Val(Cells(i, "B")) >= Val(Ar(ii)(0)) And Val(Cells(i, "B")) <= Val(Ar(ii)(1)) Then
.Offset(i, ii + 1) = Cells(i, "B")
F = False '有取得時間區段的變數=False
Exit For
End If
Next
If F = True Then .Offset(i, ii + 1) = Cells(i, "B")
i = i + 1
Loop
End With
End Sub
複製代碼
作者:
sammyc
時間:
2011-12-1 17:54
先謝謝大大的教導, 但執行後, 同一日期會出現多行
作者:
GBKEE
時間:
2011-12-2 18:19
回復
3#
sammyc
抱歉有點眼花沒看清楚題意
更正:
Option Explicit
Sub Ex()
Dim Ar(), TimeAr(1 To 6), i As Long, ii As Long, R As Integer, F As Boolean
Ar = Range("A1").CurrentRegion '備份資料
Range("A1").CurrentRegion.Sort Key1:=Range("C2"), Order1:=xlAscending, Key2:=Range("A2"), Order1:=xlAscending, Header:=xlYes '排序資料
For i = 1 To 6
TimeAr(i) = Split(Range("G3").Cells(1, i), "-") '讀取時間區段加入為TimeAr陣列的元素
Next
With Range("E2")
i = 2 '讀取資料列
R = 2 '寫入 gx,date的資料列
.CurrentRegion.Offset(2).Clear '清除 寫入區
Do
Do
.Offset(R) = Cells(i, "C") '寫入 gx
.Offset(R, 1) = Cells(i, "A") '寫入 date
F = True '比較前的變數=True
For ii = 1 To 6 '在6段時間裡比較後取得時間區段
If Val(Cells(i, "B")) >= Val(TimeAr(ii)(0)) And Val(Cells(i, "B")) <= Val(TimeAr(ii)(1)) Then
.Offset(R, ii + 1) = Cells(i, "B") '數值寫入時間區段
F = False '有取得時間區段的變數=False
Exit For '離開迴圈
End If
Next
If F = True Then .Offset(R, ii + 1) = Cells(i, "B")
If Cells(i, "A") <> Cells(i + 1, "A") Then R = R + 1 '不同date往下一行
i = i + 1
Loop Until Cells(i, "C") <> Cells(i + 1, "C") Or Cells(i + 1, "C") = "" '依序讀取資料直到 gx 不相同,或資料為空白
Loop Until Cells(i, "C") = "" '依序讀取資料迴圈直到資料為空白
End With
Range("A1").CurrentRegion = Ar '還原資料
End Sub
複製代碼
作者:
sammyc
時間:
2011-12-19 16:48
回復
4#
GBKEE
謝謝, 己可決問題,
歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)