一個期限顯示問題

317

請教各前輩及大大們,
小妹有一期限問題, 請教各先進, 附檔,
先行謝過..
資料區.rar (8.44 KB)

下載次數: 34

2013-9-4 10:47

ML089

題目問的不清楚，資料給的不齊全
期限資料在哪裡?
顯示的時機是什麼?

GBKEE

回復 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

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

Hsieh

回復 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

回復  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

謝謝樓上三位 GBKEE ,Hsieh ,luhpro ,前輩大大, 小妹衷心謝謝, 祝願快樂

GBKEE

回復 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

樓上三位樓主, 早晨
小妹再度請教, 我把程式加以修改, 但小妹想如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

回復 9# 317
上傳檔案看看