12
返回列表 上一主題 發帖

拿取日期

mdr0465

帖子
167 
主題
48 
精華
0 
積分
253 
點名
6  
作業系統
win7 
軟體版本
ie 
閱讀權限
20 
性別
男 
註冊時間
2015-7-8 
最後登錄
2025-9-14 
1# 跳轉到 » 正序看帖
打印
tT
發表於 2020-8-22 12:22 | 只看該作者

拿取日期

各位大大:

我寫了一段程式是篩選了某一個特定日子後再複製到另一個活頁薄, 但我只能篩選到”05/05/20” 而其他日子就篩選不到.

數據在"grouping"
篩選在"daily sales"

請各位指教, 謝謝

樣辦.rar (46.57 KB)

收藏 分享

准提部林

帖子
2843 
主題
10 
精華
0 
積分
2899 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2025-10-18 
11#
發表於 2020-8-23 17:10 | 只看該作者
本帖最後由 准提部林 於 2020-8-23 17:12 編輯

回復 10# mdr0465

資料表顯示情形:


執行結果:


xls格式檔:
Xl0000358.rar (61.61 KB)

真的不行, 還是用龍大的吧!

TOP

mdr0465

帖子
167 
主題
48 
精華
0 
積分
253 
點名
6  
作業系統
win7 
軟體版本
ie 
閱讀權限
20 
性別
男 
註冊時間
2015-7-8 
最後登錄
2025-9-14 
10#
發表於 2020-8-23 16:40 | 只看該作者
回復 9# 准提部林


版主你好, 真的謝謝你的幫忙
我知道你一定是測試成功才會放上來給我參考
但小弟不才, 我依據你程式修改了, 但都是依然不成功, 我不知道錯在那里,
它始終都是顯示找不到相對的日子:'(
懇請麻煩你幫忙指出附件中的錯處:handshake

樣辦.rar (127.4 KB)

TOP

准提部林

帖子
2843 
主題
10 
精華
0 
積分
2899 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2025-10-18 
9#
發表於 2020-8-23 16:00 | 只看該作者
回復 8# mdr0465


If Qs = "" Then Exit Sub
QQ = Split(Qs & "//", "/")
Qs = 20 & QQ(2) & "/" & QQ(1) & "/" & QQ(0)
If IsDate(Qs) = False Then MsgBox "日期輸入錯誤, 重新輸入! ": GoTo ReTry
QQ = DateSerial(QQ(2), QQ(1), QQ(0))

可能是電腦系統日期格式設定不同吧!
我這一定是測過了ok才會確認的,
那還是改用dateserial看看,
反正前面已判斷過日期的正確性,
這dateserial就是一個正確日期~~

TOP

mdr0465

帖子
167 
主題
48 
精華
0 
積分
253 
點名
6  
作業系統
win7 
軟體版本
ie 
閱讀權限
20 
性別
男 
註冊時間
2015-7-8 
最後登錄
2025-9-14 
8#
發表於 2020-8-23 15:53 | 只看該作者
回復 7# 准提部林


   
版主,謝謝你的備用
但我在套用你的程式,
我永遠都是顯示"找不到符合日期的資料！"

現附上已加程式的附件,請幫忙查看,謝謝

樣辦.rar (127.09 KB)

TOP

准提部林

帖子
2843 
主題
10 
精華
0 
積分
2899 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2025-10-18 
7#
發表於 2020-8-23 12:27 | 只看該作者
加個防呆:
Sub Daily_Sales()
Dim Qs$, QQ, R&, DateFmt$, xArea As Range
ReTry:
Qs = InputBox("請輸入要查詢的日期" & Chr(10) & Chr(10) & "輸入規則：DD/MM/YY")
If Qs = "" Then Exit Sub
QQ = Split(Qs & "//", "/")
Qs = 20 & QQ(2) & "/" & QQ(1) & "/" & QQ(0)
If IsDate(Qs) = False Then MsgBox "日期輸入錯誤, 請重新輸入! ": GoTo ReTry
QQ = DateValue(Qs)
'---------------------------------------------
Application.ScreenUpdating = False
Sheets("DAILY SALES").UsedRange.Offset(1, 0).EntireRow.Delete
Set xArea = Range([GROUPING!K1], [GROUPING!A1].Cells(Rows.Count, 1).End(xlUp))
With xArea
     .AutoFilter Field:=2, Criteria1:=QQ
     .Offset(1, 0).Copy Sheets("DAILY SALES").[A2]
     .Parent.ShowAllData
End With
With Sheets("DAILY SALES").UsedRange
     R = .Cells(.Rows.Count + 1, 2).End(xlUp).Row
     If R = 1 Then MsgBox "找不到符合日期的資料！　": Exit Sub
     .Columns(2).NumberFormatLocal = "dd/mm/yy"
     .EntireColumn.AutoFit
End With
End Sub

注意:============================
DD = DateSerial(2020, 13, 35) '月份超過12, 日期超過31
MsgBox DD '一樣會被視為日期

DD = DateSerial(2019, 2, 29) '2019.2月沒有29日
MsgBox DD '=2019/3/1


===============================

TOP

mdr0465

帖子
167 
主題
48 
精華
0 
積分
253 
點名
6  
作業系統
win7 
軟體版本
ie 
閱讀權限
20 
性別
男 
註冊時間
2015-7-8 
最後登錄
2025-9-14 
6#
發表於 2020-8-22 22:15 | 只看該作者
回復 4# n7822123

阿龍師兄
成功了，謝謝你的幫忙

TOP

准提部林

帖子
2843 
主題
10 
精華
0 
積分
2899 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2025-10-18 
5#
發表於 2020-8-22 20:27 | 只看該作者
回復 1# mdr0465


資料表日期格式為:yyyy/m/d
怎又用 dd/mm/yy 去篩選??? 違反常規日期的輸入方法, 洋人的???

TOP

n7822123
　暱稱: 阿龍

中學生Rank: 2

帖子
406 
主題
8 
精華
0 
積分
453 
點名
0  
作業系統
WINDOWS 7 
軟體版本
2007 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2015-2-7 
最後登錄
2021-7-31 
4#
發表於 2020-8-22 17:18 | 只看該作者
回復 3# mdr0465

因為我記得你的程式還有其他問題....................

我改了一些，已忘記改了哪些了，程式貼給你

輸入日期的時候不要輸入 雙引號 "

你自己比對吧~~程式如下

Sub Daily_Sales()
Dim xR As Range
Dim D1 As Date
Dim strformat As String
Dim splitstr() As String
Dim str As String
On Error Resume Next
Sheets("DAILY SALES").Range("A2:K1000").Clear
str = InputBox("Please Input The Date You Want to Search" & Chr(10) & Chr(10) & "Input Format ""DD/MM/YY""")
splitstr = Split(str, "/")
D1 = DateSerial(CInt(splitstr(2)), CInt(splitstr(1)), CInt(splitstr(0)))
S1$ = Format(D1, "dd/mm/yy")
Set xR = Range("GROUPING!A1:K10000")
With xR
    .AutoFilter
    .AutoFilter Field:=2, Criteria1:=S1
    Range("GROUPING!A1").CurrentRegion.Copy
    Sheets("DAILY SALES").Range("A1").PasteSpecial xlValues
    .AutoFilter
End With
Sheets("DAILY SALES").Activate
With Range([K2], [A65536].End(xlUp)) 'set borders
    .Borders.LineStyle = xlContinuous
    .Borders.Weight = xlThin
    .Borders.ColorIndex = xlAutomatic
    .Font.Size = 18
    .Font.Name = "Times New Roman"
    .HorizontalAlignment = xlCenter
    .EntireColumn.AutoFit
End With
k = 2  ' for exchange date format
Do Until IsEmpty(Cells(k, 2))
    Cells(k, 2).NumberFormatLocal = "dd""/""mm""/""yy;@"
    k = k + 1
Loop
Range("A1").Select
End Sub

檔案如下

樣辦.rar (45.49 KB)
程式是依需求寫的，需求表達不清楚
或者沒有上傳附件，愛莫能助

TOP

mdr0465

帖子
167 
主題
48 
精華
0 
積分
253 
點名
6  
作業系統
win7 
軟體版本
ie 
閱讀權限
20 
性別
男 
註冊時間
2015-7-8 
最後登錄
2025-9-14 
3#
發表於 2020-8-22 17:11 | 只看該作者
回復 2# n7822123


阿龍師兄
謝謝你的回覆,但我改了紅色的字眼,但都是運行不了, 請問我問題出在那里呢?

我輸入是
"01/06/20"
"1/6/20"
"01/06/2020"

TOP

        靜思自在 : 謊言像一朵盛開的鮮花，外表美麗，生命短暫。
12
返回列表 上一主題