donod

A1min.rar (135.22 KB)

下載次數: 7

2013-9-2 15:56

再請教如何將指定時段內的指定數值取代上一個/下一個時段內相關數值?之後重新排列(如Sheet1中的右邊例子)，再三謝謝!
指定時段:
9:14, 12:59, 16:59 這3個時段的"Open"數值取代下一個時段9:15, 13:00, 17:00的"Open"數值
16:15, 12:00, 23:00 這3個時段的"Close"數值取代上一個時段16:14, 11:59, 22:59的"Close"數值

GBKEE

回復 11# donod

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim Rng(1 To 3) As Range, i  As Integer, Ar(), S
   
4.     Set Rng(1) = Sheets("Sheet1").Range("b:b")
   
5.     Ar = Array(#9:14:00 AM#, #12:59:00 PM#, #4:59:00 PM#, #4:15:00 PM#, #12:00:00 PM#, #11:00:00 PM#)
   
6.     For i = 0 To UBound(Ar)
   
7.         Set Rng(2) = Rng(1).Find(Ar(i), LookIn:=xlFormulas)
   
8.         If Not Rng(2) Is Nothing Then
   
9.             S = Rng(2).Address
   
10.             Do
    
11.                 If i <= Int(UBound(Ar) / 2) Then
    
12.                     Rng(2).Offset(1, 1) = Rng(2).Offset(, 1)
    
13.                 Else
    
14.                     Rng(2).Offset(-1, 4) = Rng(2).Offset(, 4)
    
15.                 End If
    
16.                 If Not Rng(3) Is Nothing Then
    
17.                     Set Rng(3) = Union(Rng(3), Rng(1).Parent.Range(Rng(1).Parent.Cells(Rng(2).Row, "a"), Rng(1).Parent.Cells(Rng(2).Row, "g")))
    
18.                 Else
    
19.                     Set Rng(3) = Rng(1).Parent.Range(Rng(1).Parent.Cells(Rng(2).Row, "a"), Rng(1).Parent.Cells(Rng(2).Row, "g"))
    
20.                 End If
    
21.                 Set Rng(2) = Rng(1).FindNext(Rng(2))
    
22.             Loop Until S = Rng(2).Address
    
23.         End If
    
24.     Next
    
25.      If Not Rng(3) Is Nothing Then Rng(3).Delete
    
26. End Sub

複製代碼

donod

回復 12# GBKEE
要感謝的太多了!感謝GEKEE版大教導!

donod

再請教如何將B欄的時間自動增加1分鐘(e.g. 9:15轉為9:16)
之後在H欄顯示相關Date Code(e.g. 5130916 代表5月13日9:16)
謝謝!
A1min.rar (140.66 KB)

下載次數: 5

2013-9-5 12:58

GBKEE

回復 14# donod
試試看

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim D As Variant, E As Range
   
4.     For Each E In Range("b2", [b2].End(xlDown))
   
5.         D = Split(E.Offset(, -1), "/")
   
6.         E.Value = E + #12:01:00 AM#
   
7.         E.Offset(, 6) = D(0) & D(1) & Replace(E.Text, ":", "")
   
8.     Next
   
9. End Sub

複製代碼

還是

1. Sub Ex1()
   
2.     Dim D As Variant, E As Range, b As Date
   
3.     For Each E In Range("b2", [b2].End(xlDown))
   
4.         b = E + #12:01:00 AM#
   
5.         D = Split(E.Offset(, -1), "/")
   
6.         E.Offset(, 6) = D(0) & D(1) & Application.Text(b, "hhmm")
   
7.     Next
   
8. End Sub

複製代碼

donod

回復 15# GBKEE
跟從GBKEE版大的指導，成功了!再三感謝!

1. Option Explicit
   
2. 
   
3. Sub Ex()
   
4. 
   
5.     Dim D As Variant, E As Range, b As Date
   
6. 
   
7.     For Each E In Range("b2", [b2].End(xlDown))
   
8. 
   
9.         D = Split(E.Offset(, -1), "/")
   
10.         
    
11.         b = E + #12:01:00 AM#
    
12. 
    
13.         E.Value = E + #12:01:00 AM#
    
14. 
    
15.         'E.Offset(, 6) = D(0) & D(1) & Replace(E.Text, ":", "")
    
16.          E.Offset(, 6) = D(0) & D(1) & Application.Text(b, "hhmm")
    
17. 
    
18.     Next
    
19. 
    
20. End Sub

複製代碼

donod

請問如果要處理的檔案A.xls已經打開，以上的VBA檔案在B.xlsm，如何寫才能對A.xls作自動變動，謝謝!

donod

這個不行

1. Sub Ex()
   
2. 
   
3. 
   
4. 
   
5.     Dim D As Variant, E As Range, b As Date
   
6.   
   
7.     Windows("A.xls").Activate
   
8.     Sheets("Sheet1").Select
   
9.       
   
10.     With ActiveWorkbook.Sheets(1)
    
11.    
    
12.    
    
13.         For Each E In Range("b1", [b1].End(xlDown))
    
14. 
    
15.           D = Split(E.Offset(, -1), "/")
    
16.         
    
17.           b = E + #12:01:00 AM#
    
18. 
    
19.           E.Value = E + #12:01:00 AM#
    
20. 
    
21.           E.Offset(, 6) = D(0) & D(1) & Application.Text(b, "hhmm")
    
22. 
    
23.         Next
    
24.    
    
25.    
    
26.     End With
    
27. 
    
28. End Sub

複製代碼

B.rar (11.78 KB)

下載次數: 3

2013-9-5 18:12

GBKEE

回復 18# donod

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim D As Variant, E As Range, b As Date
   
4.     With Workbooks("A.xls").Sheets("Sheet1")
   
5.         For Each E In .Range("b2", .[b2].End(xlDown))
   
6.             D = Split(E.Offset(, -1), "/")
   
7.             b = E + #12:01:00 AM#
   
8.             E.Value = E + #12:01:00 AM#
   
9.             E.Offset(, 6) = D(0) & D(1) & Application.Text(b, "hhmm")
   
10.         Next
    
11.     End With
    
12. End Sub

複製代碼

donod

回復 19# GBKEE
明白了，感謝GBKEE版大教導!