返回列表 上一主題 發帖

一個期限顯示問題

回復 1# 317
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Rng As Range, f As Range, R As Integer
  4.     With Sheets("工作表1")
  5.         Set Rng = .Range("C:C").SpecialCells(xlCellTypeConstants)
  6.         Set f = Rng.Find(InputBox("輸入 酒名"), LOOKAT:=xlWhole)
  7.         If Not f Is Nothing Then
  8.             If .Cells(f.Row, "H") <> "" Then
  9.                 R = f.Row
  10.             Else
  11.                 R = .Cells(f.Row, "H").End(xlUp).Row
  12.                 If R = Rng.Cells(1).Row Then R = R + 1
  13.             End If
  14.             MsgBox f & "到期日" & .Cells(R, "H")
  15.         End If
  16.     End With
  17. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 4# 317
  1. Option Explicit
  2. Sub Ex()
  3.     Dim R As Integer, ym As String, mystr As String, A As Range
  4.     With Sheets("工作表1")
  5.         R = Range("C:C").SpecialCells(xlCellTypeConstants).End(xlDown).Row
  6.         ym = InputBox("輸入到期年月 格式[yyyymm]", , Format(.[H4], "YYYYMM"))
  7.         For Each A In .Range("H:H").SpecialCells(xlCellTypeConstants)
  8.             If IsDate(A) Then
  9.               If Format(A, "yyyyMm") = ym Then
  10.                 If A.End(xlDown).Row > R Then
  11.                     mystr = Join(Application.Transpose(.Range("C" & A.Row & ":C" & R)), vbLf)
  12.                 Else
  13.                     mystr = Join(Application.Transpose(.Range("C" & A.Row & ":C" & A.End(xlDown).Row - 1)), vbLf)
  14.                 End If
  15.                 Exit For
  16.             End If
  17.         End If
  18.         Next
  19.         MsgBox IIf(mystr <> "", ym & " 到期" & vbLf & mystr, ym & " 沒有到期的酒")
  20.     End With
  21. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 9# 317
上傳檔案看看
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 11# 317
對話盒中只顯示到期貨物, 如輸入沒有到紅酒月份時, 亦會作出提示該月份沒有到期紅酒,
可以再解釋一下嗎?
試著修改如下
  1. Option Explicit
  2. Sub Ex()
  3.   Dim ym As String, Rng As Range, A As Range, mystr As String, R As Integer
  4.   ym = InputBox("輸入入貨年月", , 201308)
  5.   Set Rng = Range("B:B").SpecialCells(xlCellTypeConstants)
  6.   For Each A In Rng
  7.     If IsDate(A) Then
  8.       If Format(Cells(A.Row, "B"), "yyyymm") >= ym Then  '****
  9.         If mystr = "" Then mystr = "入貨日期" & vbTab & "編號" & vbTab & "名稱" & vbTab & "級別" & vbTab & "到期日"
  10.         If Cells(A.Row, "m") <> "" Then
  11.           R = A.Row
  12.         Else
  13.           R = Cells(A.Row, "m").End(xlUp).Row
  14.           If R = Rng.Cells(1).Row Then R = R + 1
  15.         End If
  16.         mystr = mystr & vbLf & Format(Cells(A.Row, "B"), "yyyy/mm/dd") & vbTab & Cells(A.Row, "c").Text & vbTab & Cells(A.Row, "d").Text & vbTab & Cells(A.Row, "e") & vbTab & Cells(R, "m")
  17.       End If
  18.     End If
  19.   Next
  20.   MsgBox IIf(mystr <> "", mystr, ym & " 沒有到期的酒")
  21. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

本帖最後由 GBKEE 於 2013-9-5 20:45 編輯

回復 13# 317
  1. Option Explicit
  2. Sub Ex()
  3.     Dim ym As String, A As Range, mystr As String, R As Integer, i As Integer
  4.     With Sheets("工作表3")
  5.         ym = InputBox("輸入到期日 年月", , Format(.[M4], "YYYYMM"))
  6.         For Each A In .Range("M:M").SpecialCells(xlCellTypeConstants)
  7.            
  8.             If Format(A, "yyyymm") = ym Then  '****
  9.                 Debug.Print A.Row
  10.                 If mystr = "" Then mystr = "入貨日期" & vbTab & "編號" & vbTab & "名稱" & vbTab & "級別" & vbTab & "到期日"
  11.                 If A.End(xlDown).Row <> Rows.Count Then
  12.                     R = A.End(xlDown).Row - 1
  13.                 Else
  14.                     R = .Cells(A.Row, "B").End(xlDown).Row
  15.                 End If
  16.                 For i = A.Row To R
  17.                     mystr = mystr & vbLf & Format(.Cells(i, "B"), "yyyy/mm/dd") & vbTab & .Cells(i, "c") & vbTab & .Cells(i, "d") & vbTab & .Cells(i, "e") & vbTab & .Cells(A.Row, "m")
  18.                 Next
  19.             End If
  20.         Next
  21.   End With
  22.   MsgBox IIf(mystr <> "", mystr, ym & " 沒有到期的酒")
  23. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 15# 317
5列至第8列都是沒有到期日, 可否把沒有到期日不顯示出來,
  1. For i = A.Row To R
  2.                     mystr = mystr & vbLf & Format(.Cells(i, "B"), "yyyy/mm/dd") & vbTab & .Cells(i, "c") & vbTab & .Cells(i, "d") & vbTab & .Cells(i, "e") & vbTab & .Cells(i, "m").Text   '.Cells(A.Row, "m")改成.Cells(i, "m")
  3.                 Next
複製代碼

2,在窗框內第一行標籤編號,名稱, 級別, 到期日, 可否移至該行位置中位, 因這看起來, 是不會有混亂感覺

     
如圖 是依 13#的檔案執行14#的程式碼,沒有你說的混亂感覺.
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 欣賞別人就是莊嚴自己。
返回列表 上一主題