依所劃分的時間抓資料加總

帖子: 72
主題: 24
精華: 0
積分: 172
點名: 0
作業系統: xp
軟體版本: office 2003
閱讀權限: 20
性別: 男
註冊時間: 2010-7-16
最後登錄: 2023-7-6

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2011-3-29 14:35 | 只看該作者

依所劃分的時間抓資料加總

請問一下有辦法用巨集
把不同時間的資料，但依時間的區格把他分別匯出加總嗎??
麻煩解答謝謝

Book1.zip (1.98 KB)

樓主熱帖

oobird

　頭銜: 街友一族

帖子: 1572
主題: 16
精華: 2
積分: 1521
點名: 0
作業系統: xp
軟體版本: office 2003
閱讀權限: 150
性別: 男
註冊時間: 2010-5-1
最後登錄: 2016-1-13

論壇貢獻勳章

2^#

發表於 2011-3-29 16:34 | 只看該作者

Sub yy()
Dim arr(1 To 6, 0), rng, i%, h%
rng = [c5:d12]
For i = 1 To UBound(rng)
h = Application.Match(Hour(rng(i, 1)), Array(0, 4, 8, 12, 16, 20))
If h > 0 Then
arr(h, 0) = arr(h, 0) + rng(i, 2)
End If
Next
[g5].Resize(6, 1) = arr
End Sub

複製代碼

帖子: 72
主題: 24
精華: 0
積分: 172
點名: 0
作業系統: xp
軟體版本: office 2003
閱讀權限: 20
性別: 男
註冊時間: 2010-7-16
最後登錄: 2023-7-6

3^#

發表於 2011-3-30 07:57 | 只看該作者

請問一下若是我匯出的欄位不是連續的，可能是g5 0000-0400
g7 0400-0800
像這樣我要在哪邊更改匯出的位置
在麻煩解答謝謝

GBKEE

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

4^#

發表於 2011-3-30 09:02 | 只看該作者

回復 3# imzues

Sub Ex()
Dim E As Range, R As Range, i As Integer, A As Variant, Timer As Date
For Each E In [F5:F10]
A = Split(E, "-")
i = 0
For Each R In [C5:C12]
Timer = TimeSerial(Hour(R), Minute(R), 0)
If Timer >= TimeValue(Format(A(0), "00:00")) Then
If Timer <= TimeValue(Format(A(1), "00:00")) Then
i = i + R.Cells(1, 2)
End If
End If
Next
E.Cells(1, 2) = i
Next
End Sub

複製代碼

帖子: 72
主題: 24
精華: 0
積分: 172
點名: 0
作業系統: xp
軟體版本: office 2003
閱讀權限: 20
性別: 男
註冊時間: 2010-7-16
最後登錄: 2023-7-6

5^#

發表於 2011-3-30 16:13 | 只看該作者

不好意思我可能講得不太清楚，若是我原本是G5那格是0000-0400
G6那個是0400-0800
但我現在想要每空一格貼資料的話，例如：G5那格是0000-0400
G7那個是0400-0800
有辦法做到嗎？因為我不太會改
再麻煩解答感謝

GBKEE

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

6^#

發表於 2011-3-30 19:09 | 只看該作者

回復 5# imzues
附上檔案說明會清楚些

Hsieh

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 253
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2024-11-22

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

7^#

發表於 2011-3-30 19:33 | 只看該作者

回復 5# imzues

Sub nn()
Dim A As Range, t#
Set d = CreateObject("Scripting.Dictionary")
For i = 0 To 20 Step 4
mystr = Format(i / 24, "hhmm") & "-" & IIf(i = 20, 2400, Format((i + 4) / 24, "hhmm"))
d(mystr) = i / 24
Next
kys = d.keys: ar = d.items
d.RemoveAll
For Each A In Range([C5], [C65536].End(xlUp))
t = TimeValue(Format(A, "hh:mm"))
ky = kys(Application.Match(t, ar) - 1)
d(ky) = d(ky) + A.Offset(, 1)
Next
For Each A In Range([F5], [F65536].End(xlUp)).SpecialCells(xlCellTypeConstants)
A.Offset(, 1) = d(A.Value)
Next
End Sub

複製代碼

學海無涯_不恥下問

帖子: 72
主題: 24
精華: 0
積分: 172
點名: 0
作業系統: xp
軟體版本: office 2003
閱讀權限: 20
性別: 男
註冊時間: 2010-7-16
最後登錄: 2023-7-6

8^#

發表於 2011-3-31 13:15 | 只看該作者

就像檔案的那種格式在幫忙解答謝謝

Book11.zip (4.29 KB)

oobird

　頭銜: 街友一族

帖子: 1572
主題: 16
精華: 2
積分: 1521
點名: 0
作業系統: xp
軟體版本: office 2003
閱讀權限: 150
性別: 男
註冊時間: 2010-5-1
最後登錄: 2016-1-13

論壇貢獻勳章

9^#

發表於 2011-3-31 15:23 | 只看該作者

Dim arr(1 To 11, 0), rng, i%, h%

rng = [c5:d12]

For i = 1 To UBound(rng)

h = Application.Match(Hour(rng(i, 1)), Array(0, 4, 8, 12, 16, 20))

If h > 0 Then

arr(h * 2 - 1, 0) = arr(h * 2 - 1, 0) + rng(i, 2)

End If

Next

[g5].Resize(11, 1) = arr

帖子: 72
主題: 24
精華: 0
積分: 172
點名: 0
作業系統: xp
軟體版本: office 2003
閱讀權限: 20
性別: 男
註冊時間: 2010-7-16
最後登錄: 2023-7-6

10^#

發表於 2011-4-1 09:17 | 只看該作者

感謝各位大大的解答!!!