[英]VBA - update find function to loop through rows and move on if value isn't there
嘗試組合一個宏來搜索每一行以查看其是否包含7個搜索詞(請參見下面的“保修:”示例)。 如果該單元格以短語之一開頭(例如“ Warranty:”(保修:)),則該單元格將粘貼到另一個工作表中的特定單元格(相同的行,但不同的列)中。
問題:
如果該行沒有單詞,則會發生錯誤-需要它以繼續瀏覽
Sub FindTest() Worksheets("Macro").Range("1:1").Find(What:="Warranty: ", LookIn:=xlValues, LookAt:=xlPart, MatchCase:=True).Copy 'Cell begins with "Warranty:" but text following varies Sheets("CSV Upload").Select Sheets("CSV Upload").Range("J1").Select ActiveSheet.Paste End Sub
更新:
Sub FindTest()
Dim Macro As Worksheet: Set Macro = Sheets("Macro")
Dim CSV As Worksheet: Set CSV = Sheets("CSV Upload")
'On Error Resume Next
For R = 1 To Macro.UsedRange.Rows.Count
Set rng = Macro.Rows(R)
Dim FindRange As Range: Set FindRange = rng.Find(What:="Warranty:", LookIn:=xlValues, LookAt:=xlPart, MatchCase:=True)
'FindRange.Copy CSV.Range("J1")
'CSV.Cells(1, J) = Macro.Cells(FindRange)
Next
'On Error GoTo 0
End Sub
要遍歷工作表中的每一行:
Dim ws As Worksheet: Set ws = Sheets("Macro")
Dim csv_upload As workseet: Set csv_upload = Sheets("CSV Upload")
For r = 1 To ws.UsedRange.Rows.Count
Set rng = ws.Rows(r)
rng.Find(What:="Warranty: ", LookIn:=xlValues, LookAt:=xlPart, MatchCase:=True)
...
Next
然后復制值,具體取決於您需要復制的單元格
csv_upload.cells(dest_row, dest_col) = ws.cells(orig_row, orig_col)
要讓它在出現錯誤時繼續運行,可以告訴它恢復
On Error Resume Next
' potential for error to be raised
' Don't use this unless you know you are going to get a specific
' error and know there are no unintended consequences of ignoring it.
On Error GoTo 0
使用更新中的代碼,以下代碼將為您工作。
Sub FindWarranty()
Dim Macro As Worksheet: Set Macro = Sheets("Macro")
Dim CSV As Worksheet: Set CSV = Sheets("CSV Upload")
Dim rng As Range, FindRange As Range
Dim Phrase As String
Phrase = "Warranty:"
For r = 1 To Macro.UsedRange.Rows.Count
Set rng = Macro.Rows(r)
Set FindRange = rng.Find(What:=Phrase, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=True)
If Not FindRange Is Nothing Then
' Set destination cell to what you need it to be
c = 1
CSV.Cells(r, c) = FindRange
End If
Next
End Sub
Quicksilver提到的一種更優雅的方式是:
Sub FindWarrantys()
Dim Macro As Worksheet: Set Macro = Sheets("Macro")
Dim CSV As Worksheet: Set CSV = Sheets("CSV Upload")
Dim FoundCell As Range, FirstAddr As String
Dim Phrase As String, c As Integer
Phrase = "Warranty:"
' Find the first occurrence. The after variable is set to the
' last cell so that it will start searching from the beginning.
Set FoundCell = Macro.UsedRange.Find(what:=Phrase, _
after:=Macro.UsedRange.Cells(Macro.UsedRange.Cells.Count))
' Save the address of the first occurrence to prevent an infinite loop
If Not FoundCell Is Nothing Then
FirstAddr = FoundCell.Address
End If
' Loop through all finds
Do Until FoundCell Is Nothing
c = 1 ' Adjust for logic to determine which column
CSV.Cells(FoundCell.Row, c) = FoundCell
' Find the next occurrence
Set FoundCell = Macro.UsedRange.FindNext(after:=FoundCell)
' Break if we're back at the first address
If FoundCell.Address = FirstAddr Then
Exit Do
End If
Loop
End Sub
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.