Как заставить al oop сделать ctrl + f для каждого значения в столбце?

Question

Я пытаюсь создать макрос для вставки нового столбца после последнего занятого столбца на листе, затем поиск заголовка столбца «Номер детали» в моем примере и Ctrl + F для поиска каждой строки, указанной в столбце, и найдите его в другой книге. Если строка найдена в этой книге, я хочу, чтобы «Найдено в« Имя книги »» было заполнено в той же строке, что и номер детали, которую она только что искала, но в столбце, который был создан в начале. Это часть более крупной функции, поэтому я передаю все переменные, в том числе то, что ищется для «colTitle1», книгу и лист значений, «BOM», лист «BOMSheet» и документ, в котором выполняется поиск » SearchDo c ".

Основная функция здесь:

Public Sub OCCLCheck(colTitle As String, BOM As Workbook, BOMSheet As Worksheet)

Dim OCCL As Variant
Dim OpenBook As Workbook
Dim pn As Variant
Dim lastRow As Integer

'Counts number of rows in Column A with content
lastRow = WorksheetFunction.CountA(Range("A:A"))


'Flashy but not good for regular use - uncomment when not showing off product
'Application.ScreenUpdating = False

'Code for user to indicate the OCCL doc with a file path box - add something to prompt again if cancelled
OCCL = Application.GetOpenFilename(Title:="Choose OCCL File", FileFilter:="Excel Files (*.xls*),*xls*")
    If OCCL <> False Then
        Set OpenBook = Application.Workbooks.Open(OCCL)
        'OpenBook.Sheets(1).Range("A1:E20").Copy
    End If

'Application.ScreenUpdating = True

Call SearchFunc("Part Number", BOM, BOMSheet, OCCL)

End Sub

Функция поиска здесь:

Public Sub SearchFunc(colTitle1 As String, BOM As Workbook, BOMSheet As Worksheet, SearchDoc As Workbook)

Dim pn As String
Dim colTitle2 As String
Dim c As Variant
Dim lastRow As Integer
'Code to search for something on something else, made for searching across books

'Find the column with colTitle1
With ActiveSheet.UsedRange
    Set c = .find(colTitle1, LookIn:=xlValues)
    If Not c Is Nothing Then
        pn = ActiveSheet.Range(c.Address).Offset(1, 0).Select
    End If
End With

'Count number of rows to iterate search through
lastRow = WorksheetFunction.CountA(Range("A:A"))

        For i = 1 To lastRow

        If Cells.find(What:=Workbooks(BOM).Worksheets(BOMSheet).Range(i, 2).Value, After:=ActiveCell, _
            LookIn:=Workbooks(SearchDoc).Worksheets(1).xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False).Activate <> .Range(i, 2).Value Then 'Write not on occl to first unoccupied column also add code to find unoccupied column before this loop
        End If

End Sub

Я довольно потерян, где go Теперь, когда я знаю, что я хочу сделать, но я новичок в VBA, поэтому получение программы для этого - мой проблемный банкомат, любые предложения приветствуются!

Это ошибка макроса при поиске const «Номер детали» [ 3

Answer 1

Большинство основных частей, необходимых для построения вашего решения, должны быть в этом сценарии. Я использовал xlWhole в Find, чтобы ABC1 не совпадал с ABC10, но если номера деталей фиксированной длины, возможно, xlPart в порядке. Рефакторинг в меньшие подводные лодки и функционирует по мере необходимости.

Option Explicit
Sub macro()

    Const COL_TITLE = "Part Number"

    Dim wb As Workbook, ws As Worksheet, found As Range
    Dim wbSearch As Workbook, wsSearch As Worksheet

    Dim rng As Range, iResultCol As Integer, iPartCol As Integer
    Set wb = ThisWorkbook
    Set ws = wb.Sheets("BOM D6480000005")

    ' headers
    Set rng = ws.UsedRange.Rows(1)

    ' determine part number col
    Set found = rng.Find(COL_TITLE, , xlValues, xlPart)
    If found Is Nothing Then
      MsgBox "Can't find " & COL_TITLE, vbCritical, "Search failed"
      Exit Sub
    End If
    iPartCol = found.Column

    ' determine last col
    iResultCol = rng.Columns.count + rng.Column
    ws.Cells(1, iResultCol) = "Search Result"
    Debug.Print rng.Address, iPartCol, iResultCol

    Dim sFilename As String
    sFilename = Application.GetOpenFilename(Title:="Choose OCCL File", FileFilter:="Excel Files (*.xls*),*xls*")
    If Len(sFilename) > 0 Then
       Set wbSearch = Application.Workbooks.Open(sFilename)
    Else
       MsgBox "No file chosen", vbExclamation
       Exit Sub
    End If

    ' find last row
    Dim iLastRow As Long, iRow As Long, sPartNo As String, count As Long
    iLastRow = ws.Cells(Rows.count, iPartCol).End(xlUp).Row
    Debug.Print "iLastRow", iLastRow

    ' search each sheet
    For Each wsSearch In wbSearch.Sheets
        For iRow = 2 To iLastRow
            sPartNo = ws.Cells(iRow, iPartCol)
            If Len(sPartNo) > 0 Then
                Set found = wsSearch.UsedRange.Find(sPartNo, , xlValues, xlWhole)
                If found Is Nothing Then
                ' not found
                Else
                    ws.Cells(iRow, iResultCol) = "Found in " & wbSearch.Name & _
                    " " & wsSearch.Name & _
                    " at " & found.Address

                    count = count + 1
                End If
            End If
        Next
    Next

    ' end
    wbSearch.Close False
    MsgBox count & " matches", vbInformation, "Finished"

End Sub