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

複製代碼

GBKEE

回復 46# 198188
改成

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

複製代碼

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

GBKEE

回復 51# 198188
日期都會出現 : 這是儲存格的日期格式
你只說 ETA 欄set >=41291  你需要查看整個程式哪裡有設定了, 儲存格的日期格式 為 .NumberFormatLocal = "[$-C04]d mmmm, yy;@"
改為  .NumberFormatLocal = "G/通用格式"
這些格式程式碼 可用錄製巨集得到
PS : $-C04 香港地區 的格式代號