帖子: 9
主題: 3
精華: 0
積分: 62
點名: 1
作業系統: Window 7
軟體版本: Office 2010
閱讀權限: 20
性別: 男
來自: 臺北
註冊時間: 2018-10-25
最後登錄: 2024-5-16

2019 豬年全勤獎章

1^# 跳轉到 » 倒序看帖

字體大小: tT

發表於 2022-9-2 12:00 | 只看該作者

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

大家好

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

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

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

再請各位協助幫忙指出問題與解法，謝謝

Sub 替代料表用資材查詢220901()
'
Dim find_data, dat_rng, data_end, data_row, CleanFail
Application.ScreenUpdating = False
Sheets("查詢").Select
Range("B2:BQ16").ClearContents
For i = 2 To 16
If Cells(i, "A") = "" Then
Exit For
Else
find_data = Sheets("查詢").Cells(i, "A")
Cells(i, "A").Select
Sheets("總表").Select
date_end = Range(Selection, ActiveCell.SpecialCells(xlCellTypeLastCell)).Address
date_rng = "A1:" & date_end
Cells.Find(What:=find_data, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, MatchByte:=False, SearchFormat:=False).Activate
Selection.End(xlToRight).Select
Selection.Copy
Sheets("查詢").Select
Cells(i, "A").Select
ActiveCell.Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("總表").Select
Selection.End(xlToRight).Offset(0, 1).Select
Selection.Copy
Sheets("查詢").Select
ActiveCell.Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("總表").Select
Selection.Offset(0, 2).Select
Range(Selection, Selection.End(xlToRight)).Copy
Sheets("查詢").Select
ActiveCell.Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
Next
Cells(ActiveWindow.ActivePane.ScrollRow, ActiveWindow.ActivePane.ScrollColumn).Select
Application.ScreenUpdating = True
End Sub

複製代碼

CUT.JPG (134.13 KB)

試驗料表up.rar (36.75 KB)

替代

樓主熱帖

VBA 新手進化中

samwang

大學生 Rank: 4

帖子: 976
主題: 7
精華: 0
積分: 1018
點名: 0
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 50
性別: 男
註冊時間: 2013-4-19
最後登錄: 2024-10-30

2^#

發表於 2022-9-2 15:07 | 只看該作者

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

TOP

JT1221

中學生 Rank: 2

帖子: 9
主題: 3
精華: 0
積分: 62
點名: 1
作業系統: Window 7
軟體版本: Office 2010
閱讀權限: 20
性別: 男
來自: 臺北
註冊時間: 2018-10-25
最後登錄: 2024-5-16

2019 豬年全勤獎章

3^#

發表於 2022-9-2 15:49 | 只看該作者

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

回復 2# samwang

Hi Sam

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

VBA 新手進化中

TOP

Andy2483

　暱稱: 厚臉皮的學生

大學生 Rank: 4

帖子: 1446
主題: 40
精華: 0
積分: 1470
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2024-10-21

4^#

發表於 2022-9-2 16:48 | 只看該作者

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

TOP

JT1221

中學生 Rank: 2

帖子: 9
主題: 3
精華: 0
積分: 62
點名: 1
作業系統: Window 7
軟體版本: Office 2010
閱讀權限: 20
性別: 男
來自: 臺北
註冊時間: 2018-10-25
最後登錄: 2024-5-16

2019 豬年全勤獎章

5^#

發表於 2022-9-6 12:00 | 只看該作者

回復 4# Andy2483

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

VBA 新手進化中

TOP