Board logo

標題: [發問] input box輸入 比對資料 [打印本頁]
作者: v03586    時間: 2015-10-8 21:32     標題: input box輸入 比對資料

小弟又有一個小問題

這是一個Output按鈕，會去比對Input date
[attach]22172[/attach]

點選按鈕後輸入MO去比對資料表B欄位的MO
如果有一樣的MO就在同欄的Output資料欄(F欄)上自動帶入時間
[attach]22173[/attach]

我有寫一段程式碼 但不知道如何寫搜尋功能...煩請大大協助
如果要將搜尋到的資料反底色程式碼會很複雜嗎?  <額外功能 可有可無>
  1. Sub Outwafer()
  2. EnterMOo:
  3.     P = InputBox("請輸入MO [Please enter MO]", "請輸入MO [Please enter MO]", "")
  4.      If Len(P) < 7 Then
  5.       If MsgBox("你的輸入有誤，是否重新輸入一個MO?" & vbCrLf & _
  6.                 "點擊""是""重新輸入，""否""退出當次輸入。" & vbCrLf & _
  7.                 "You are not enter MO ,Click ""是(Y)""Re-enter or ""否(N)""End enter", vbYesNo Or vbQuestion, "無輸入MO [You are not enter MO]") = vbYes Then GoTo EnterMOo
  8.       Exit Sub
  9.     End If
  10.    
  11. EnterOID:
  12.     G = InputBox("請輸入工號 [Please enter OP ID]", "請輸入工號 [Please enter OP ID]", "")
  13.     If Len(G) < 1 Then
  14.       If MsgBox("你的輸入有誤，是否重新輸入工號?" & vbCrLf & _
  15.                 "點擊""是""重新輸入，""否""退出當次輸入。" & vbCrLf & _
  16.                 "You are not enter OP ID ,Click ""是(Y)""Re-enter or ""否(N)""End enter", vbYesNo Or vbQuestion, "無輸入工號 [You are not enter OP ID]") = vbYes Then GoTo EnterOID
  17.       Exit Sub
  18.     End If

  20.     Dim C2 As Integer
  21.     C2 = 2
  22.     While Cells(C2, 2) <> ""
  23.     C2 = C2 + 1
  24.     Wend
  25.     Cells(C2, 6) = Now()
  26.     Cells(C2, 7) = G

  28. End Sub
複製代碼
另再問一下 如果刪除功能，要改成比對F欄位 超過3個月
程式碼該如何修改呢?
  1. Sub 刪除()
  2. Dim R&
  3. R = Application.CountIf([Database!C:C], "<" & Date - 90)
  4. If R > 0 Then [Database!A2:C2].Resize(R).Delete Shift:=xlUp

  6. R = Application.CountIf([Database!F:F], "<" & Date - 90)
  7. If R > 0 Then [Database!D2:F2].Resize(R).Delete Shift:=xlUp
  8. End Sub
複製代碼
作者: v03586    時間: 2015-10-8 21:37

例如我輸入28445621 資料表B欄有這筆資料 就在F欄位上帶入時間表示Ouput了 作業員ID
如下圖
[attach]22174[/attach]
作者: v03586    時間: 2015-10-12 00:27

[attach]22184[/attach]
作者: lpk187    時間: 2015-10-12 07:12

回復 1# v03586

查詢比對的方式有很多種，討論區中有太多例子了，下列提供2種給你參考：
  1.     With Sheets("工作表1")
  2.         For Each Rng In .Range("b2:B" & Cells(Rows.Count, 2).End(xlUp).Row)
  3.             If Rng <> "" Then
  4.                 If Rng Like P Then
  5.                     Rng.Offset(, 4) = Rng.Offset(, -1)
  6.                     Rng.Offset(, 5) = G
  7.                 End If
  8.             End If
  9.         Next
  10.     End With
複製代碼
  1.     Dim Rng As Range
  2.     With Sheets("工作表1")
  3.         With .Columns(2)
  4.             Set Rng = .Find(P, , , 1, , 2)
  5.                 If Not Rng Is Nothing Then
  6.                     Rng.Offset(, 4) = Rng.Offset(, -1)
  7.                     Rng.Offset(, 5) = G
  8.                 Else
  9.                     MsgBox "查無資料"
  10.                 End If
  11.         End With
  12.     End With
複製代碼
作者: v03586    時間: 2015-10-12 21:44

回復 4# lpk187


    感謝大大的提供！我在稍微做個修改！:)



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