Board logo

標題: 一個期限顯示問題 [打印本頁]
作者: 317    時間: 2013-9-4 10:47     標題: 一個期限顯示問題

請教各前輩及大大們,
小妹有一期限問題, 請教各先進, 附檔,
先行謝過..
[attach]15931[/attach]
作者: ML089    時間: 2013-9-4 11:33

題目問的不清楚，資料給的不齊全
期限資料在哪裡?
顯示的時機是什麼?
作者: GBKEE    時間: 2013-9-4 12:04

回復 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
複製代碼
作者: 317    時間: 2013-9-4 17:48

回復 3# GBKEE
謝謝版大, 這是我所需要, 但忽然有個想法, 能否把輸入名稱改為年份加月份, 如啟動巨集, 在顯示框中輸入年份及月份, 月份物品全數顥示,
小妹知道這是有難度, 不過是想知多一點, 學多一點.. 謝謝大大,
作者: Hsieh    時間: 2013-9-4 23:04

回復 4# 317
  1. Sub ex()
  2. ym = InputBox("輸入入貨年月", , 201308)
  3. For Each a In Range("H:H").SpecialCells(xlCellTypeConstants)
  4.    If IsDate(a) Then
  5.       If Format(Cells(a.Row, "B"), "yyyymm") = ym Then
  6.          mystr = IIf(mystr = "", Cells(a.Row, "B").Text & " " & Cells(a.Row, "C") & "到期日" & a.Text, mystr & Chr(10) & Cells(a.Row, "B").Text & " " & Cells(a.Row, "C") & "到期日" & a.Text)
  7.       End If
  8.    End If
  9. Next
  10. MsgBox mystr
  11. End Sub
複製代碼
作者: luhpro    時間: 2013-9-4 23:41

回復  GBKEE
謝謝版大, 這是我所需要, 但忽然有個想法, 能否把輸入名稱改為年份加月份, 如啟動巨集, 在顯 ...
317 發表於 2013-9-4 17:48

我猜樓主要的可能是只要是該月份進貨的都要秀出來,
所以我參考 3# 將 5# 修改了一下 :
  1. Sub ex()
  2.   ym = InputBox("輸入入貨年月", , 201308)
  3.   Set Rng = Range("B:B").SpecialCells(xlCellTypeConstants)
  4.   For Each a In Rng
  5.     If IsDate(a) Then
  6.       If Format(Cells(a.Row, "B"), "yyyymm") = ym Then
  7.         stemp = IIf(mystr = "", "", Chr(10))
  8.         If Cells(a.Row, "H") <> "" Then
  9.           R = a.Row
  10.         Else
  11.           R = Cells(a.Row, "H").End(xlUp).Row
  12.           If R = Rng.Cells(1).Row Then R = R + 1
  13.         End If
  14.         mystr = mystr & stemp & "入貨日期 : " & Cells(a.Row, "B").Text & "  " & Cells(a.Row, "C") & "  到期日 : " & Cells(R, "H")
  15.       End If
  16.     End If
  17.   Next
  18.   MsgBox mystr
  19. End Sub
複製代碼
作者: 317    時間: 2013-9-5 00:13

本帖最後由 317 於 2013-9-5 00:14 編輯

謝謝樓上三位 GBKEE ,Hsieh ,luhpro ,前輩大大, 小妹衷心謝謝, 祝願快樂
作者: GBKEE    時間: 2013-9-5 07:29

回復 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
複製代碼
作者: 317    時間: 2013-9-5 09:56

樓上三位樓主, 早晨
小妹再度請教, 我把程式加以修改, 但小妹想如GBKEE版大大, 對話盒中只顯示到期貨物,
如輸入沒有到紅酒月份時, 亦會作出提示該月份沒有到期紅酒,
小妹試圖把GBKEE版大大程式混入下列程式中, 但不成功, 故請樓主們協助, 謝謝謝!

Sub Ex()

  ym = InputBox("輸入入貨年月", , 201308)

  Set Rng = Range("B:B").SpecialCells(xlCellTypeConstants)

  For Each A In Rng

    If IsDate(A) Then

      If Format(Cells(A.Row, "B"), "yyyymm") = ym Then

        stemp = IIf(mystr = "", "", Chr(10))

        If Cells(A.Row, "m") <> "" Then

          R = A.Row

        Else

          R = Cells(A.Row, "m").End(xlUp).Row

          If R = Rng.Cells(1).Row Then R = R + 1

        End If

        mystr = mystr & stemp & "入貨日期 : " & Cells(A.Row, "B").Text & "編號 :  " & Cells(A.Row, "c").Text & "名稱 :  " & Cells(A.Row, "d").Text & "級別 :" & Cells(A.Row, "e") & "  到期日 : " & Cells(R, "m")

      End If

    End If

  Next

  MsgBox IIf(mystr <> "", ym & " 到期" & vbLf & mystr, ym & " 沒有到期的酒")

End Sub
作者: GBKEE    時間: 2013-9-5 10:30

回復 9# 317
上傳檔案看看
作者: 317    時間: 2013-9-5 11:39

回復 10# GBKEE
小妹現把檔案上傳, 有勞版大, 謝謝謝!
[attach]15947[/attach]
作者: GBKEE    時間: 2013-9-5 14:36

回復 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
複製代碼
作者: 317    時間: 2013-9-5 18:23

回復 12# GBKEE

GBKEE版大, 好,
小妹現再度把整理的檔案上傳, 內有明細, 加入圖片解釋, 先行謝過版大, 感恩..
[attach]15956[/attach]
作者: GBKEE    時間: 2013-9-5 20:40

本帖最後由 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
複製代碼
作者: 317    時間: 2013-9-5 21:48

回復 14# GBKEE
GBKEE版大, 先行感謝版大回應,
有二個問題,
1, 便是我健入到期年月201312, 出示窗框如圖, 問題便在於2013/12/31日到期日只有一筆, 便是第四列, 但窗框出現把第4列至第8列都顯示出來,
而實質來說第5列至第8列都是沒有到期日, 可否把沒有到期日不顯示出來,
2,在窗框內第一行標籤編號,名稱, 級別, 到期日, 可否移至該行位置中位, 因這看起來, 是不會有混亂感覺, 謝謝
作者: GBKEE    時間: 2013-9-6 06:19

回復 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,在窗框內第一行標籤編號,名稱, 級別, 到期日, 可否移至該行位置中位, 因這看起來, 是不會有混亂感覺

  [attach]15962[/attach]  
如圖 是依 13#的檔案執行14#的程式碼,沒有你說的混亂感覺.
作者: 317    時間: 2013-9-6 08:42

回復 16# GBKEE
GBKEE版大, 早晨
衷心感謝回應, 已試行, 真心謝謝謝!!!



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