返回列表 上一主題 發帖

[發問] Cells.Find 如何讓找不到資料時就跳過

[發問] Cells.Find 如何讓找不到資料時就跳過

大家好

自己在製作表格查詢時,遇到Cells.Find的用法不知道如何能夠解決,
還請版本的各位能不吝指教,謝謝

說明:附近excel檔案有兩個頁面 (查詢、總表),當把某一些材料號碼放到『查詢』頁面的A2-A16後,
           程式可以去總表把後面的資料 (包含舊資料、替代關係、可用機型),貼到對應的欄位。

目前已經可以做查詢的功能,但如果『查詢的資料』在總表不存在就會出現以下錯誤,
『執行階段錯誤 '91':』
『沒有設定物件變數或With區塊變數』

再請各位協助幫忙指出問題與解法,謝謝
  1. Sub 替代料表用資材查詢220901()
  2. '
  3. Dim find_data, dat_rng, data_end, data_row, CleanFail
  4. Application.ScreenUpdating = False
  5. Sheets("查詢").Select
  6. Range("B2:BQ16").ClearContents

  7. For i = 2 To 16
  8.     If Cells(i, "A") = "" Then
  9.         Exit For
  10.     Else
  11.         find_data = Sheets("查詢").Cells(i, "A")
  12.         Cells(i, "A").Select
  13.         Sheets("總表").Select
  14.         date_end = Range(Selection, ActiveCell.SpecialCells(xlCellTypeLastCell)).Address
  15.         date_rng = "A1:" & date_end
  16.             
  17.         Cells.Find(What:=find_data, After:=ActiveCell, LookIn:=xlValues, _
  18.             LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
  19.             MatchCase:=False, MatchByte:=False, SearchFormat:=False).Activate
  20.                         
  21.         Selection.End(xlToRight).Select
  22.         Selection.Copy
  23.         Sheets("查詢").Select
  24.         Cells(i, "A").Select
  25.         ActiveCell.Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  26.                 :=False, Transpose:=False
  27.         Sheets("總表").Select
  28.         Selection.End(xlToRight).Offset(0, 1).Select
  29.         Selection.Copy
  30.         Sheets("查詢").Select
  31.         ActiveCell.Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  32.                 :=False, Transpose:=False
  33.         Sheets("總表").Select
  34.         Selection.Offset(0, 2).Select
  35.         Range(Selection, Selection.End(xlToRight)).Copy
  36.         Sheets("查詢").Select
  37.         ActiveCell.Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  38.                 :=False, Transpose:=False

  39.     End If

  40. Next

  41. Cells(ActiveWindow.ActivePane.ScrollRow, ActiveWindow.ActivePane.ScrollColumn).Select
  42. Application.ScreenUpdating = True

  43. End Sub
複製代碼

CUT.JPG (134.13 KB)

CUT.JPG

試驗料表up.rar (36.75 KB)

替代

VBA 新手進化中

本帖最後由 JT1221 於 2022-9-2 15:51 編輯

回復 2# samwang


Hi Sam

感謝回覆,查詢的資料完全正確
程式碼也精簡非常多!
再次感謝!  {:3_61:}
VBA 新手進化中

TOP

回復 4# Andy2483

    Hi Andy
         感謝回覆另外的寫法,我會在研究一下寫法!!  :handshake
VBA 新手進化中

TOP

        靜思自在 : 成功是優點的發揮,失敗是缺點的累積。
返回列表 上一主題