Question

Я пытаюсь сделать что-то похожее на несколько столбцов.Я даже не знаю, как это назвать, поэтому я даже не знаю, как искать.«составное совпадение» ...?

У меня есть набор «кандидатов» чисел (каждый из которых представляет собой 25-символьный код) на листе (лист называется «RPT - срок годности»).В другом рабочем листе ("MasterSheet", который, кстати, содержит тысячи или десятки тысяч строк) я хочу определить, существует ли следующее условие:

Есть листрока, где столбец D равен CANDIDATE_NUMBER, а столбец F = "бананы" или "апельсины"?(ответ может быть значением строки в MasterSheet)

(примечание: в столбце F будут значения, отличные от "бананов" или "апельсинов", и я должен их игнорировать.)

Сейчас, на данный момент, я делаю это очень тупо:

' Now loop through each of the candidates and hunt for TRANSACTION TYPES that match the ScanID,
' and are either SCHEDULED or DEPLOYED. These are items that ARE NOT STALE. Repair their flags.
  Dim LastRowOfCandidates As Long
  Dim ShelfAgeCounter As Long
  Dim MastersheetTransactionRowIndex As Long
  Dim CandidateScanID As Long
  Dim ItemResolved As Boolean
  LastRowOfCandidates = Worksheets("RPT - Shelf Age").Cells(Rows.Count, 1).End(xlUp).Row
   MsgBox ("There are " & LastRowOfCandidates & " rows of complete data in this report." & vbCrLf)
  For ShelfAgeCounter = 3 To LastRowOfCandidates ' cycle through each candidate
    ItemResolved = False
    TargetRow = 2
    MastersheetTransactionRowIndex = Worksheets("RPT - Shelf Age").Cells(ShelfAgeCounter, 1) ' this is the row in which the candidate appears on the MasterSheet
    CandidateScanID = MastersheetTransactionRowIndex = Worksheets("RPT - Shelf Age").Cells(ShelfAgeCounter, 4) ' the ScanID to hunt for
     'Search the MasterSheet for any occurrence of CandidateScanID where the action is SCHEDULE or DEPLOYED
      Do Until Worksheets("MasterSheet").Cells(TargetRow, 1) = "" Or ItemResolved = True
        If Worksheets("MasterSheet").Cells(TargetRow, 4) = CandidateScanID And Worksheets("MasterSheet").Cells(TargetRow, 6) = "Scheduled for Delivery" Then
          'Worksheets("MasterSheet").Cells(MastersheetTransactionRowIndex, 37) = ""
          ItemResolved = True
        End If
        If Worksheets("MasterSheet").Cells(TargetRow, 4) = CandidateScanID And Worksheets("MasterSheet").Cells(TargetRow, 6) = "Equipment Deployed" Then
          Worksheets("MasterSheet").Cells(MastersheetTransactionRowIndex, 37) = ""
          ItemResolved = True
        End If
        TargetRow = TargetRow + 1
      Loop ' finished looking for a match on MasterSheet
  Next

Теперь, это работает, но святая галочка, это занимает много времени.

Учитывая, что это Excel и у него могут быть очень быстрые способы поиска данных в своих собственных таблицах, есть ли способ, при котором не требует Макс. Время поиска = Количество CANDIDATES * Количество строк MasterSheet?

Спасибо, любезно!

- = - = - = - = - = - = -

Приложение:

Этовся подпрограмма, включая попытку использовать AUTOFILTER:

Private Sub Worksheet_Activate()
  Worksheets("RPT - Shelf Age").Rows("3:5000").EntireRow.Delete ' I REALLY hope there aren't more than 5000 stale items!
  Worksheets("RPT - Shelf Age").Range("A3").Activate
  Dim CurrentReportRow As Long
  Dim TargetRow As Long
  CurrentReportRow = 3
  TargetRow = 2
  ' Pull in all the CANDIDATE items from the Master Sheet that have perhaps not yet been reconciled
  ' This is not a full data set because I only need a few values to scrub through Candidates.
    Do Until Worksheets("MasterSheet").Cells(TargetRow, 1) = ""
      If Worksheets("MasterSheet").Cells(TargetRow, 37) = 1 Then
        Worksheets("RPT - Shelf Age").Cells(CurrentReportRow, 1) = TargetRow
        Worksheets("RPT - Shelf Age").Cells(CurrentReportRow, 2) = Left(Worksheets("MasterSheet").Cells(TargetRow, 4), 10)
        Worksheets("RPT - Shelf Age").Cells(CurrentReportRow, 3) = Mid(Worksheets("MasterSheet").Cells(TargetRow, 4), 12, 11)
        Worksheets("RPT - Shelf Age").Cells(CurrentReportRow, 4) = Worksheets("MasterSheet").Cells(TargetRow, 4)
        CurrentReportRow = CurrentReportRow + 1
      End If
      TargetRow = TargetRow + 1
    Loop

MsgBox ("Hold up there a sec, hoss!") ' I include this test stop to let me review the table before proceeding.

    Dim wb As Workbook
    Dim wsMaster As Worksheet
    Dim wsRPT As Worksheet
    Dim rFound As Range
    Dim aCandidateIDs As Variant
    Dim vID As Variant
    Set wb = ActiveWorkbook
    Set wsMaster = wb.Worksheets("MasterSheet")
    Set wsRPT = wb.Worksheets("RPT - Shelf Age")
    With wsRPT.Range("D3", wsRPT.Cells(wsRPT.Rows.Count, "D").End(xlUp))
        If .Row < 3 Then Exit Sub   ' No data
        If .Cells.Count = 1 Then
            ReDim aCandidateIDs(1 To 1, 1 To 1)
            aCandidateIDs(1, 1) = .Value
        Else
            aCandidateIDs = .Value
        End If
    End With
    With wsMaster.Range("D1:F" & wsMaster.Cells(wsMaster.Rows.Count, "D").End(xlUp).Row)
        For Each vID In aCandidateIDs
            .AutoFilter 1, vID                                                  'Filter column D for the ID
            .AutoFilter 3, "Scheduled for Delivery", xlOr, "Equipment Deployed" 'Filter column F for the two other strings

             ' Check if there are any results
            On Error Resume Next
            Set rFound = .Offset(1).SpecialCells(xlCellTypeVisible).Cells(1) ' This assumes you only want the first match found.  For all matches, leave off the .Cells(1)
            On Error GoTo 0
            .AutoFilter 'Remove the filter
            If Not rFound Is Nothing Then
                ' Found a match, do something with it here
                ' Because we only returned the first match, no need to iterate over rFound because it will only be 1 cell
                MsgBox "Candidate ID: " & vID & Chr(10) & "Match found on MasterSheet at row: " & rFound.Row
            End If
        Next vID
    End With

    ' Now loop through each of the candidates and hunt for TRANSACTION TYPES that match the ScanID,
    ' and are either SCHEDULED or DEPLOYED. These are items that ARE NOT STALE. Repair their flags.
      'Dim LastRowOfCandidates As Long
      'Dim ShelfAgeCounter As Long
      'Dim MastersheetTransactionRowIndex As Long
      'Dim CandidateScanID As Long
      'Dim ItemResolved As Boolean
      'LastRowOfCandidates = Worksheets("RPT - Shelf Age").Cells(Rows.Count, 1).End(xlUp).Row
      ' MsgBox ("There are " & LastRowOfCandidates & " rows of complete data in this report." & vbCrLf)
      'For ShelfAgeCounter = 3 To LastRowOfCandidates ' cycle through each candidate
        'ItemResolved = False
        'TargetRow = 2
        'MastersheetTransactionRowIndex = Worksheets("RPT - Shelf Age").Cells(ShelfAgeCounter, 1) ' this is the row in which the candidate appears on the MasterSheet
        'CandidateScanID = MastersheetTransactionRowIndex = Worksheets("RPT - Shelf Age").Cells(ShelfAgeCounter, 4) ' the ScanID to hunt for
        ' Search the MasterSheet for any occurrence of CandidateScanID where the action is SCHEDULE or DEPLOYED
          'Do Until Worksheets("MasterSheet").Cells(TargetRow, 1) = "" Or ItemResolved = True
            'If Worksheets("MasterSheet").Cells(TargetRow, 4) = CandidateScanID And Worksheets("MasterSheet").Cells(TargetRow, 6) = "Scheduled for Delivery" Then
              'Worksheets("MasterSheet").Cells(MastersheetTransactionRowIndex, 37) = ""
              'ItemResolved = True
            'End If
            'If Worksheets("MasterSheet").Cells(TargetRow, 4) = CandidateScanID And Worksheets("MasterSheet").Cells(TargetRow, 6) = "Equipment Deployed" Then
              'Worksheets("MasterSheet").Cells(MastersheetTransactionRowIndex, 37) = ""
              'ItemResolved = True
            'End If
            'TargetRow = TargetRow + 1
          'Loop ' finished looking for a match on MasterSheet
      'Next

  ' Empty out this table
    Worksheets("RPT - Shelf Age").Rows("3:5000").EntireRow.Delete ' I REALLY hope there aren't more than 5000 stale items!
    Worksheets("RPT - Shelf Age").Range("A3").Activate
  ' Pull in all the items from the Master Sheet that are still scheduled or deployed.
    CurrentReportRow = 3
    TargetRow = 2
    Worksheets("RPT - Shelf Age").Columns(5).Interior.Color = xlNone
    Do Until Worksheets("MasterSheet").Cells(TargetRow, 1) = ""
      If Worksheets("MasterSheet").Cells(TargetRow, 37) = 1 Then
        Worksheets("RPT - Shelf Age").Cells(CurrentReportRow, 1) = TargetRow ' Transaction ID
        Worksheets("RPT - Shelf Age").Cells(CurrentReportRow, 2) = Left(Worksheets("MasterSheet").Cells(TargetRow, 4), 10) ' REQ
        Worksheets("RPT - Shelf Age").Cells(CurrentReportRow, 3) = Mid(Worksheets("MasterSheet").Cells(TargetRow, 4), 12, 11) ' RITM
        Worksheets("RPT - Shelf Age").Cells(CurrentReportRow, 4) = Worksheets("MasterSheet").Cells(TargetRow, 7) ' Depot timestamp
        Worksheets("RPT - Shelf Age").Cells(CurrentReportRow, 5) = Now - Worksheets("RPT - Shelf Age").Cells(CurrentReportRow, 4) ' Age in days
        If Worksheets("RPT - Shelf Age").Cells(CurrentReportRow, 5) > 3 Then ' if the item is older than 1 day, highlight the cell
          Worksheets("RPT - Shelf Age").Cells(CurrentReportRow, 5).Interior.Color = RGB(255, 0, 0)
        End If
        CurrentReportRow = CurrentReportRow + 1
      End If
      TargetRow = TargetRow + 1
    Loop
    Worksheets("RPT - Shelf Age").Columns(4).NumberFormat = "mmm d, yyyy at h:mm AM/PM"
  ' Sort the table by that age -- oldest presenting first.
    Dim lastrow As Long
    lastrow = Cells(Rows.Count, 1).End(xlUp).Row
    With Workbooks("Equipment_Transactions.xlsm").Sheets("RPT - Shelf Age")
      With .Range("a3").CurrentRegion
        .Sort key1:=.Cells(5), order1:=xlDescending, Header:=xlYes
      End With
    End With
End Sub

edit (по состоянию на 28 мая 2019 г.):

Есть ли функция уровня ячейки, которую я могу внедрить, чтобы решить эту проблему?Например, когда я лежу в исходной строке «удалено из депо», я вручную добавляю флаг «1» в столбец AK, но, возможно, я могу добавить команду уровня ячейки, которая в основном говорит: «Сделайте эту ячейку самостоятельно вычислять.Если на этом листе есть какая-либо другая строка, значение столбца D которой совпадает со значением столбца D этой строки, а соответствующая строка имеет значение «Запланировано» или «Развернуто» в столбце F, то это значение должно быть пустым, нов противном случае эта ячейка должна содержать 1. "

Тогда я могу просто отфильтровать все элементы, где столбец AK содержит 1, и я знаю, что они уже согласованы.

Редактировать (9 июня, 2019):

Мой приятель предложил: «Почему бы вам просто не запихнуть все эти данные таблицы в большой массив, а затем выполнить свои вычисления и поиск по массиву.Возвращайтесь к таблице только тогда, когда вы хотите изменить значение ячейки ».

Люди, которые знают Excel VBA: это предложение, которое значительно улучшило бы мою скорость?В настоящее время у меня есть около 4500 строк данных, так что это довольно большой массив для сборки.Но если это намного быстрее, может быть, того стоит ...?

Хм, я, вероятно, что-то делаю не так ...

Dim SearchArray() As Variant
Dim GobbleRange As Range

      Set GobbleRange = Worksheets("MasterSheet").Range("D2:F10000") ' The top 10,000 rows, columns D, E, F
      ReDim SearchArray(3, 10000)
MsgBox ("Array built and re-dimmed.")
      SearchArray = Range(GobbleRange).Value2
MsgBox ("Array populated with contents of entire MasterSheet")

Я получаю Ошибка времени выполнения '1004 ': метод' Range 'объекта' _Worksheet 'не выполнен выделение строки "SearchArray = Range (GobbleRange) .Value2"

Мысли?Идеи?Предложения?

Edward Martin III · Answer 1 · 11 июня 2019

Хорошо!

Во-первых, спасибо всем, кто помог мне исследовать идеи.Это все помогло.Спасибо @Chris, который предложил этот последний толчок в правильном направлении.

Решение оказалось следующим:

Бросьте все содержимое мастер-таблицы в огромный массив.
Выполнить все мои сопоставления с образцом и поиск по массиву.
Если операции с массивами говорят мне об изменении значения в таблице (происходит, может быть, 5-20 раз в день), тогдаэто изменение в таблице.

Первоначальный проход через систему занял около 45 секунд.Сгребая все данные в массив, а затем проталкивая этот массив вместо таблицы, я сократил это до пяти секунд.Я мог бы урезать его еще больше, но, честно говоря, пяти секунд для циклического перебора всех данных, вероятно, достаточно хорошо!

Win!

tigeravatar · Answer 2 · 24 мая 2019

Используйте автофильтр, чтобы избежать циклов и найти свои совпадения, например:

Sub tgr()

    Dim wb As Workbook
    Dim wsMaster As Worksheet
    Dim wsRPT As Worksheet
    Dim rFound As Range
    Dim aCandidateIDs As Variant
    Dim vID As Variant

    Set wb = ActiveWorkbook
    Set wsMaster = wb.Worksheets("MasterSheet")
    Set wsRPT = wb.Worksheets("RPT - Shelf Age")

    With wsRPT.Range("D3", wsRPT.Cells(wsRPT.Rows.Count, "D").End(xlUp))
        If .Row < 3 Then Exit Sub   'No data
        If .Cells.Count = 1 Then
            ReDim aCandidateIDs(1 To 1, 1 To 1)
            aCandidateIDs(1, 1) = .Value
        Else
            aCandidateIDs = .Value
        End If
    End With

    With wsMaster.Range("D1:F" & wsMaster.Cells(wsMaster.Rows.Count, "D").End(xlUp).Row)
        For Each vID In aCandidateIDs
            .AutoFilter 1, vID                                                  'Filter column D for the ID
            .AutoFilter 3, "Scheduled for Delivery", xlOr, "Equipment Deployed" 'Filter column F for the two other strings

            'Check if there are any results
            On Error Resume Next
            Set rFound = .Offset(1).SpecialCells(xlCellTypeVisible).Cells(1)    'This assumes you only want the first match found.  For all matches, leave off the .Cells(1)
            On Error GoTo 0

            .AutoFilter 'Remove the filter

            If Not rFound Is Nothing Then
                'Found a match, do something with it here
                'Because we only returned the first match, no need to iterate over rFound because it will only be 1 cell
                MsgBox "Candidate ID: " & vID & Chr(10) & "Match found on MasterSheet at row: " & rFound.Row
            End If
        Next vID
    End With

End Sub

Сложный, многозначный поиск быстрее, чем тупой цикл?

Пожалуйста, войдите или зарегистрируйтесь чтобы ответить на этот вопрос.

Ответы [ 2 ]

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Сложный, многозначный поиск быстрее, чем тупой цикл?

Пожалуйста, войдите или зарегистрируйтесь чтобы ответить на этот вопрос.

Ответы [ 2 ]

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Нет похожих вопросов