- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
4#
發表於 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
|
|
發表於 2011-12-1 16:28
| 
