麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] 請問怎麼比較日期? [打印本頁]

作者: SinYun 時間: 2015-9-1 17:12 標題: 請問怎麼比較日期?

[attach]21886[/attach]

如圖所示我已經可以把B欄日期用程式碼比較出來

但是現在要利用A欄找出同一位客戶但是B欄要顯示最新的

例如成輔企業 2017/11/30

想請問這樣程式碼要怎麼樣編寫

Sub 日期比較()
dim a as variant,b as variant
a=range("b1").value
b=range("b2").value
if a>b then
range("c1").value=range("b1").value
msgbox range("c1").value
else
range("c1").value=range("b2").value
msgbox range("c1").value
end if
end sub

複製代碼

這程式碼要怎麼改才能找同一位客戶到期日最新
請教各位了謝謝

作者: ikboy 時間: 2015-9-1 23:10

Sub zz()
Dim arr, d
arr = [a1].CurrentRegion
Set d = CreateObject("scripting.dictionary")
For i = 2 To UBound(arr)
If Not d.exists(d(arr(i, 1))) Then
d(arr(i, 1)) = arr(i, 2)
Else
If arr(i, 2) + 0 > d(arr(i, 1)) + 0 Then d(arr(i, 1)) = arr(i, 2)
End If
Next
Workbooks.Add
[a1].Resize(d.Count, 2) = Application.Transpose(Array(d.keys, d.items))
End Sub

作者: GBKEE 時間: 2015-9-2 08:33

回復 1# SinYun
試試看

Option Explicit
Sub EX()
Dim xlMax As Date
With ActiveSheet
.Range("A1").AutoFilter FIELD:=1, Criteria1:="成輔企業有限公司" '工作表指定範圍自動篩選,給準則
xlMax = Application.WorksheetFunction.Max(Columns(2).SpecialCells(xlCellTypeVisible))
'篩選後可見資料的最大值
.Range("A1").AutoFilter '工作表指定範圍取消自動篩選
End With
MsgBox xlMax
End Sub

複製代碼

作者: yoyobuy 時間: 2015-9-2 08:44

回復 3# GBKEE

AitoFilter 如果設定 Criteria1:="abc"  時
理應找不到任何符合的項目
但是 excel  sheet 卻還是出現一筆項目
這該如何解決呢

Sub EX()
      Dim xlMax As Date
         Range("A1").AutoFilter FIELD:=1, Criteria1:="abc" '工作表指定範圍自動篩選,給準則
         xlMax = Application.WorksheetFunction.Max(Columns(2).SpecialCells(xlCellTypeVisible))
                                                                  '篩選後可見資料的最大值
         ' Range("A1").AutoFilter                               '工作表指定範圍取消自動篩選

      MsgBox xlMax
End Sub

作者: SinYun 時間: 2015-9-2 09:42

回復 3# GBKEE
謝謝GBKEE 他現在可以操作但我有疑問是我指定範圍但不一定是那家公司這樣可以嗎?要給別人操作的

回復 2# ikboy
謝謝你

作者: GBKEE 時間: 2015-9-2 11:14

回復 5# SinYun

Option Explicit
Sub EX()
Dim xlMax As Date, Co As String
Co = InputBox("成輔企業有限公司", "輸入公司名稱")
With ActiveSheet
.Range("A1").AutoFilter FIELD:=1, Criteria1:=Co '工作表指定範圍自動篩選,給準則
xlMax = Application.WorksheetFunction.Max(Columns(2).SpecialCells(xlCellTypeVisible))
'篩選後可見資料的最大值
.Range("A1").AutoFilter '工作表指定範圍取消自動篩選
End With
MsgBox IIf(xlMax > 0, xlMax, "查無 " & Co)
End Sub

複製代碼

作者: 准提部林 時間: 2015-9-2 16:15

若資料不多，用公式比較方便，
Ｃ１下拉清單輸入查詢文字，
Ｄ１公式：
=IF(C1="","",SUMPRODUCT(MAX((A$2:A$999=C1)*B$2:B$999)))

作者: SinYun 時間: 2015-9-2 16:23

回復 9# 准提部林

抱歉就是因為資料很多又卡到要顯示最新的日期貼出來的只是練習
練習結束就要弄到資料比較多的

作者: SinYun 時間: 2015-9-2 16:30

回復 3# GBKEE

抱歉可以麻煩版主幫我把#7跟#8刪除嗎 ?
我想要統一在這一樓問才比較不耽誤版主時間

我執行後 MsgBox IIf(xlMax > 0, xlMax, "查無 " & Co) 這一句沒有辦法出現他會一直跑出最大的那個日期
我直接改成下拉式選單可以嗎?

Option Explicit
Sub EX()
Dim xlMax As Date, Co As String
Co = InputBox("輸入公司名稱", "輸入公司名稱")
With ActiveSheet
.Range("H1").AutoFilter FIELD:=8, Criteria1:=Co '工作表指定範圍自動篩選,給準則
xlMax = Application.WorksheetFunction.Max(Columns(30).SpecialCells(xlCellTypeVisible))
'篩選後可見資料的最大值
.Range("H1").AutoFilter '工作表指定範圍取消自動篩選
End With
MsgBox IIf(xlMax > 0, xlMax, "查無 " & Co)
End Sub

複製代碼

這程式碼我改成這樣但他顯示[attach]21890[/attach]
這是哪裡錯誤呢 ? 因為我修改了定義他還是不行

作者: 准提部林 時間: 2015-9-2 16:59

Ｃ１下拉清單輸入查詢值，結果放在Ｄ１

Sub 找最大日期()
Dim i&, Arr, DD, MXD
[D1] = "": If [C1] = "" Then Exit Sub
Arr = Range([A2], [B65536].End(xlUp))
For i = 1 To UBound(Arr)
　　DD = Arr(i, 2)
　　If Arr(i, 1) = [C1] And IsDate(DD) Then If DD > MXD Then MXD = DD
Next i
If IsDate(MXD) Then [D1] = MXD Else [D1] = "找不到"
End Sub

Autofilter 雖然好用，但資料多又有其它公式大量引用此資料表時，自動重算會是個問題（若ＰＣ等級高就不須考慮這問題）
　

作者: SinYun 時間: 2015-9-3 11:32

回復 6# GBKEE

我的檔案公司有加密我沒有辦法弄給你耶
他是跟我說如錯誤訊息說的找不到他的屬性
這有辦法解決他的屬性方法嗎?

作者: SinYun 時間: 2015-9-3 13:45

回復 6# GBKEE

Option Explicit
Sub EX()
Dim xlMax As Date, Co As String
Co = InputBox("輸入公司名稱", "輸入公司名稱")
With ActiveSheet
.Range("H1").AutoFilter FIELD:=8, Criteria1:=Co '工作表指定範圍自動篩選,給準則
xlMax = Application.WorksheetFunction.Max(Columns(30).SpecialCells(xlCellTypeVisible))
'篩選後可見資料的最大值
.Range("H1").AutoFilter '工作表指定範圍取消自動篩選
End With
MsgBox IIf(xlMax > 0, xlMax, "查無 " & Co)
End Sub

複製代碼

[attach]21898[/attach]
請查看這是欄位的確定位置
我不確定他的錯誤訊息是甚麼意思

作者: SinYun 時間: 2015-9-4 10:55

回復 10# 准提部林

抱歉可以中文解釋一下嗎 ? 有那些地方是可以欄位變動的?

作者: 准提部林 時間: 2015-9-4 13:27

回復 13# SinYun

看範例檔：

Sub 找最大日期()
Dim R&, i&, Arr, Brr, DD, MXD
[B2] = "": If [A2] = "" Then Exit Sub
　
With Sheets("工作表2").UsedRange　 '工作表已使用區域
　　Arr = .Columns("H") 　'User資料陣列
　　Brr = .Columns("AD")　 'Expire Date日期資料陣列
End With
　
DD = Application.Match([A2], Arr, 0)　'檢測查詢對象是否存在
If IsError(DD) Then [B2] = "名稱不存在": Exit Sub
For i = 2 To UBound(Arr)
　　If Arr(i, 1) = [A2] Then
　　　DD = Brr(i, 1)
　　　If IsDate(DD) Then If DD > MXD Then MXD = DD
　　End If
Next i
　
If MXD > 0 Then [B2] = MXD Else [B2] = "無日期可比對"
End Sub

複製代碼

　
[attach]21903[/attach]
　

作者: SinYun 時間: 2015-9-4 14:04

回復 14# 准提部林

SOORY~ 他說資料索引超出範圍我想問說A2跟B2是指儲存格嗎?

作者: 准提部林 時間: 2015-9-4 18:01

回復 15# SinYun

１．資料索引超出範圍　　＞＞是用範例檔執行的嗎？錯誤在哪一行？
２．我想問說A2跟B2是指儲存格嗎?　　＞＞指〔工作表3〕的A2.A3

程式碼並不複雜，先去了解〔工作表．儲存格〕的引用方法！
　

作者: SinYun 時間: 2015-9-4 18:16

回復 16# 准提部林

抱歉我的級別還不能下載附件所以我是複製下來用到我的檔案去弄
他是說第6跟第7行執行錯誤

A2 跟B2是另存新的工作表意思嗎?

作者: 准提部林 時間: 2015-9-4 19:54

回復 17# SinYun

另一下載址：
http://www.funp.net/491882

我只有OFFICE 2000，請自行去套用！

作者: GBKEE 時間: 2015-9-5 06:51

回復 14# 准提部林
你的檔案附檔名.xlsx沒有巨集的Excel檔,執行你修改的程式碼,沒有問題的.
要看看附檔名.xlsm有巨集的EXCEL檔,才知你錯在哪裡.

作者: SinYun 時間: 2015-9-7 15:44

回復 19# GBKEE

你好我的檔案太大了所以我現附上另外一個網址
http://www.funp.net/858398

請您查看我有在巨集裡貼上有問題的那個巨集

作者: 准提部林 時間: 2015-9-7 16:25

本帖最後由准提部林於 2015-9-7 16:30 編輯

回復 20# SinYun

附檔下載：
http://www.funp.net/629089
使用這個免費空間，是非得已，因很容易被移除或覆蓋，而失去永久性參考；
請多多參與討論升級，以獲得下載附件權限；當然，若能以贊助論壇方式也並無不可（相信獲得會更多）！

１．〔銷售統計〕表的〔標題〕在第２列，所以須改範圍：
　　Sheets("銷售統計").UsedRange.Offset(1, 0).Columns("H:H")
２．〔User〕名稱有〔強制換列〕，例如：
　　Per titled, the customer is
　　ウシオ電機株式会社(USHIO INC.)
　　這不是〔資料表〕輸入的常規，應輸入成一行，再使用〔格式〕的自動換列才是正辦！（不要將excel當word用）
３．〔日期〕欄有很多錯誤及無效值，理應清除或更正，這會造成統計上的困擾！（其它欄位亦然）
４．檔中程式碼經測試都ＯＫ，若在您的ＰＣ中會有錯誤，可能是OFFICE版本問題，恕無法為您排解（我只有OFFICE 2000)，
　　這就有勞與您同版本的大大來解決！
　
＿我只是無給職掛名的版主，希望以上解答對您有幫助～～
　台灣稀有的EXCEL專門論壇，需要大家多方支持～～
　

作者: GBKEE 時間: 2015-9-8 09:01

本帖最後由 GBKEE 於 2015-9-8 09:08 編輯

回復 20# SinYun

[attach]21922[/attach]

准提部林版主: ３．〔日期〕欄有很多錯誤及無效值，理應清除或更正，這會造成統計上的困擾！（其它欄位亦然）

Application.WorksheetFunction.Max 程式的錯誤,為〔日期〕欄的錯誤值所造成.
你的檔案很龐大,肇因使用大量的函數,光是開啟的重算就很費時.

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)