GBKEE

回復 39# 198188
    二個data base，就變成附件圖片
F欄要設定為日期格式 如圖

下載 (57.98 KB)

2013-1-11 16:06

198188

回復 41# GBKEE


    我試過將全部的日期格式都改成一樣，而各種日期格式都試過。
但一執行vba就會自動將格式改成數字如下，而我想將這個ETA日期減兩日，如果是星期六或日，就在另一column顯示ETA Column的日期，否則就顯示ETA日期減兩日,由於vba未能辨認數字成日期，所以全部都減2
ETA
41289.5
41291
41288.5
41295
41297
41298

GBKEE

回復 42# 198188
上傳檔案及程式碼看看.

198188

回復 43# GBKEE
1.rar (380.46 KB)

下載次數: 4

2013-1-13 00:45

2.rar (464.33 KB)

下載次數: 3

2013-1-13 00:45

3.rar (419.49 KB)

下載次數: 4

2013-1-13 00:45

vba.rar (2.65 KB)

下載次數: 3

2013-1-13 00:45

由於檔案太大，我分開了7個 excel 和一個程式的附件

GBKEE

回復 44# 198188
試試看

1. '6）
   
2. Sub Request()
   
3.     Dim rngSrc As Range, rngCopyField As Range, rngFilter As Range
   
4.     Dim nextRow As Long, endRow As Long
   
5.     Dim LastRec As Integer
   
6.     Dim i As Integer
   
7.     Dim The_day As String  '<- ****
   
8.     Sheets("Request").[A2:AG65536].ClearContents
   
9.     Set rngSrc = Sheets("State").[A1:AG65536]
   
10.     Set rngCopyField = Sheets("Rule").[B21:AH21]
    
11.     Set rngFilter = Sheets("Rule").[B14].Resize(Sheets("Rule").[B14].CurrentRegion.Rows.Count, 33)
    
12.      nextRow = 2
    
13.     Sheets("Request").UsedRange.Offset(1).Clear
    
14.     rngSrc.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
    
15.     rngFilter, CopyToRange:=Sheets("Request").Range("A" & nextRow)
    
16.          endRow = Sheets("Request").Range("A" & Sheets("Request").Rows.Count).End(xlUp)
    
17.         For i = 1 To rngCopyField.Count
    
18.         If rngCopyField(i) = "N" Then
    
19.             Sheets("Request").Range(nextRow & ":" & endRow).Columns(i).Clear
    
20.         End If
    
21.     Next
    
22.         Sheets("Request").Range("A" & nextRow).Resize(1, 33).Delete Shift:=xlUp   'delete header
    
23.        Set rngSrc = Nothing
    
24.     Set rngCopyField = Nothing
    
25.     Set rngFilter = Nothing
    
26. With Worksheets("Request")
    
27.    LastRec = .Range("A1").End(xlDown).Row
    
28.   For i = 2 To LastRec
    
29.     .Range("B" & i).Value = Application.VLookup(.Range("A" & i).Value, Sheets("State").Range("A:S"), 19, False)
    
30.     .Range("C" & i).Value = Application.VLookup(.Range("A" & i).Value, Sheets("State").Range("A:AA"), 27, False)
    
31.     .Range("D" & i).Value = Application.VLookup(.Range("A" & i).Value, Sheets("State").Range("A:U"), 21, False) & " - " & Application.VLookup(.Range("A" & i).Value, Sheets("State").Range("A:AC"), 29, False)
    
32.     .Range("E" & i).Value = Application.VLookup(.Range("A" & i).Value, Sheets("State").Range("A:AB"), 28, False)
    
33.     .Range("F" & i).Value = Application.VLookup(.Range("A" & i).Value, Sheets("State").Range("A:B"), 2, False)
    
34.     .Range("G" & i).Value = Application.VLookup(.Range("A" & i).Value, Sheets("State").Range("A:N"), 14, False)
    
35.     The_day = Format(Worksheets("Request").Range("F" & i).Value - 2, "AAA")  '傳回星期?
    
36.     If The_day = "星期六" Or The_day = "星期日" Then
    
37.         .Range("H" & i).Value = .Range("F" & i).Value
    
38.     Else
    
39.         .Range("H" & i).Text = .Range("F" & i).Value - 2
    
40.     End If
    
41.     .Range("F" & i).NumberFormatLocal = "m/d;@"   '設定日期格式
    
42.     .Range("H" & i).NumberFormatLocal = "m/d;@"   '設定日期格式
    
43.       Next
    
44.     End With
    
45. End Sub

複製代碼

198188

回復 45# GBKEE


     .Range("H" & i).Text = .Range("F" & i).Value - 2
執行階段錯誤‘1004’
無法設定種類range的text 屬性

GBKEE

回復 46# 198188
改成

1. .Range("H" & i).Value

複製代碼

198188

回復 47# GBKEE


   

下載 (38.02 KB)

2013-1-14 19:33

運行出來的結果還是一樣，不懂得辨認星期六或者星期日

GBKEE

回復 48# 198188
Debug.Print可在 即時運算視窗  中查看  The_day 傳回的字串
   

1. The_day = Format(Worksheets("Request").Range("F" & i).Value - 2, "AAA")  '傳回星期?
   
2.     Debug.Print The_day   ' *** Debug.Print可在 即時運算視窗  中查看  The_day 傳回的字串
   
3.     If The_day = "星期六" Or The_day = "星期日" Then

複製代碼

下載 (70.22 KB)

2013-1-15 16:38

198188

回復 49# GBKEE


  感謝。已經知道問題所在，我的電腦是週六或者週日，不是星期六或者星期日