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

JT1221

大家好

自己在製作表格查詢時，遇到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. 
   
8. For i = 2 To 16
   
9.     If Cells(i, "A") = "" Then
   
10.         Exit For
    
11.     Else
    
12.         find_data = Sheets("查詢").Cells(i, "A")
    
13.         Cells(i, "A").Select
    
14.         Sheets("總表").Select
    
15.         date_end = Range(Selection, ActiveCell.SpecialCells(xlCellTypeLastCell)).Address
    
16.         date_rng = "A1:" & date_end
    
17.             
    
18.         Cells.Find(What:=find_data, After:=ActiveCell, LookIn:=xlValues, _
    
19.             LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    
20.             MatchCase:=False, MatchByte:=False, SearchFormat:=False).Activate
    
21.                         
    
22.         Selection.End(xlToRight).Select
    
23.         Selection.Copy
    
24.         Sheets("查詢").Select
    
25.         Cells(i, "A").Select
    
26.         ActiveCell.Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    
27.                 :=False, Transpose:=False
    
28.         Sheets("總表").Select
    
29.         Selection.End(xlToRight).Offset(0, 1).Select
    
30.         Selection.Copy
    
31.         Sheets("查詢").Select
    
32.         ActiveCell.Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    
33.                 :=False, Transpose:=False
    
34.         Sheets("總表").Select
    
35.         Selection.Offset(0, 2).Select
    
36.         Range(Selection, Selection.End(xlToRight)).Copy
    
37.         Sheets("查詢").Select
    
38.         ActiveCell.Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    
39.                 :=False, Transpose:=False
    
40. 
    
41.     End If
    
42. 
    
43. Next
    
44. 
    
45. Cells(ActiveWindow.ActivePane.ScrollRow, ActiveWindow.ActivePane.ScrollColumn).Select
    
46. Application.ScreenUpdating = True
    
47. 
    
48. End Sub

複製代碼

samwang

回復 1# JT1221

請測試看看，謝謝
Sub test()
Dim Arr, Brr, Crr(), i&, x&, j%
Brr = Sheets("總表").Range("a1").CurrentRegion
Arr = Sheets("查詢").Range("a1").CurrentRegion
ReDim Crr(1 To UBound(Arr), 1 To UBound(Brr, 2))
For i = 2 To UBound(Arr)
    For x = 2 To UBound(Brr)
        If Arr(i, 1) = Brr(x, 1) Then
            Crr(i - 1, 1) = Brr(x, 3): Crr(i - 1, 2) = Brr(x, 6)
            For j = 8 To UBound(Brr, 2): Crr(i - 1, j - 5) = Brr(x, j): Next
        End If
    Next
Next
Sheets("查詢").Range("b2").Resize(UBound(Arr), UBound(Brr, 2)) = Crr
End Sub

JT1221

回復 2# samwang


Hi Sam

感謝回覆，查詢的資料完全正確
程式碼也精簡非常多!
再次感謝!  {:3_61:}

Andy2483

回復 1# JT1221


    另類查詢方式供前輩參考
謝謝前輩發表此帖

Option Explicit
Sub test()
Dim i, x, Arr, Brr(1 To 100000, 1 To 9), c, j, n, Crr
Arr = Sheets("總表").Range("A1").CurrentRegion
Crr = Sheets("查詢").Range("A1").CurrentRegion
c = Sheets("總表").UsedRange.Columns.Count
For i = 1 To UBound(Arr)
   For j = 8 To c
      If Trim(Arr(i, j)) = "" Or Trim(Arr(i, j)) = "A=B,A=C→B=C" Then
         Exit For
         Else
            n = n + 1
            Brr(n, 8) = Trim(Arr(i, j))
            For x = 1 To 7
               Brr(n, x) = Trim(Arr(i, x))
            Next
      End If
   Next
Next
Workbooks.Add
Cells.Font.Name = "微軟正黑體"
[A1].Resize(100000, 9) = Brr
Cells.Columns.AutoFit
Cells.Rows.AutoFit
Cells.Columns.AutoFit
[2:2].Select
ActiveWindow.FreezePanes = True
[A1].AutoFilter
[A1].Select
ActiveSheet.Name = "新總表"
Sheets.Add.Name = "新查詢"
[A1].Resize(UBound(Crr), 4) = Crr
For i = 1 To UBound(Crr)
   For x = 2 To UBound(Brr)
      If Brr(x, 1) = Crr(i, 1) Then
         If Crr(i, 2) = "" Then
            Crr(i, 2) = Brr(x, 3)
         End If
         If Crr(i, 3) = "" Then
            Crr(i, 3) = Brr(x, 6)
         End If
         If Crr(i, 4) = "" Then
            Crr(i, 4) = Brr(x, 8)
            Else
               Crr(i, 4) = Crr(i, 4) & vbLf & Brr(x, 8)
         End If
      End If
   Next
Next
[A1].Resize(UBound(Crr), 4) = Crr
[A:D].Columns.AutoFit
Cells.Rows.AutoFit
Cells.Borders.LineStyle = xlContinuous
[2:2].Select
ActiveWindow.FreezePanes = True
[A1].AutoFilter
[A1].Select
End Sub

JT1221

回復 4# Andy2483

    Hi Andy
         感謝回覆另外的寫法，我會在研究一下寫法!!  :handshake