динамическое имя файла и выделение строк

avatar
Jonathan Lim
8 апреля 2018 в 10:28
48
1
1

с хорошей помощью от вас, ребята из coderhelper, мне удалось завершить одну часть того, что я пытаюсь выполнить, однако у меня есть еще 2 части, которые... я немного пытался, но, насколько я плох в этом, я не могу разберись

что это должно делать, так это из 2 книг to_update_example_1, он будет искать то же имя в столбце H, сравнивая со столбцом H списка закупок, если найдено, скопируйте столбец QTY G (to_update_example_1) в столбец F (список закупок), который код работает отлично.

я просто пытаюсь узнать, не удалось ли обновить, затем выделите строку, которая не удалась, и в столбце O или P напишите текст «элемент не найден»

а также, когда мы загружаем наш список to_update из нашего Интернета, имя файла является динамическим, хотя имя листа является статическим, есть ли способ избежать перехода к концу кодирования, чтобы изменить имя файла, вместо этого, возможно, введите имя файла при запуске макроса или выберите файл или что-то в этом роде...

Заранее спасибо!

Option Explicit

Sub Macro1()
    Dim cell As Range, FindRng As Range, ErrorRng As Range

    Dim purchListSht As Worksheet
    Set purchListSht = Workbooks("Purchasing List.xls").Worksheets("Liltots") '(change "purchaseData" to your actual "purchase" sheet name)

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    With Workbooks("to_update_example_1").Sheets("GoodsSelInfo_LIST_SELL_INVENTOR") ' reference your "source" worksheet in "source" workbookworkbook (change "SourceData" to your actual "source" sheet name)
            For Each cell In .Range("H1", .Cells(.Rows.Count, 8).End(xlUp)).SpecialCells(xlCellTypeConstants) ' loop through referenced "source" sheet column "H" not empty cells
            Set FindRng = purchListSht.Columns("H").Find(What:=cell.Value, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns) ' try finding current cell content in "purchase" sheet column "G"
            If Not FindRng Is Nothing Then '<-- make sure Find was successful finding vVal1
             FindRng.Offset(, -2).Value = cell.Offset(, -1).Value ' if successful, write the value of the cell one column left of the current cell to the cell two columns to the left of found cell
        Else ' raise some kind of notification
            MsgBox "Unable to find " & cell, vbInformation
        End If

        Next
    End With
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

заранее спасибо!

Источник

Ответы (1)

avatar
DisplayName
8 апреля 2018 в 11:19
0

вам нужно небольшое изменение внутри цикла For Each cell:

    For Each cell In .Range("H1", .Cells(.Rows.Count, 8).End(xlUp)).SpecialCells(xlCellTypeConstants) ' loop through referenced "source" sheet column "H" not empty cells
        Set FindRng = purchListSht.Columns("G").Find(What:=cell.Value, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns) ' try finding current cell content in "purchase" sheet column "G"
        If FindRng Is Nothing Then ' if no match found
            cell.Offset(, 7).Value = "item not found" ' write in column "O" of current cell row
            Intersect(.UsedRange, cell.EntireRow).Interior.ColorIndex = 6 ' yellow highlight current cell row
        Else ' if match found
            FindRng.Offset(, -2).Value = cell.Offset(, -1).Value ' write the value of the cell one column left of the current cell to the cell two columns to the left of found cell
        End If
    Next
Jonathan Lim
8 апреля 2018 в 11:44
0

на случай, если кто-то еще может посмотреть на это, и есть небольшая опечатка Intersect(.usedrange, cell.EntireRow).Interior.ColorIndex = 6 'выделение желтого цвета текущей строки ячейки Else ', если найдено совпадение