У меня ограниченное рабочее знание макросов Excel VBA. У меня есть два листа под названием "Сводка" и "Данные"

  • Сводная таблица имеет фиксированные строки и столбцы.
  • Таблица данных имеет значения в нем.

Мне нужно сравнить код, номер MRC компании и статус сводной таблицы и таблицы данных, и, если поля совпадают, получить соответствующее значение из таблицы данных в поле «Сводная информация».

превосходить

1 ответ1

0

Мое решение основано на прилагаемом снимке экрана, где я обнаружил только две общие колонки между листами.

1. Код

2. Компания MRC

Я не могу найти поле Status of Summary & Data.

Я хотел бы предложить набор макросов для сравнения обоих листов для общих данных, которые будут скопированы в другой лист.

Sub CompareRanges()

Dim WorkRng1 As Range, WorkRng2 As Range, Rng1 As Range, Rng2 As Range

Set WorkRng1 = Application.InputBox("Range A:", "", Type:=8)
Set WorkRng2 = Application.InputBox("Range B:", Type:=8)

For Each Rng1 In WorkRng1
rng1Value = Rng1.Value

For Each Rng2 In WorkRng2

If rng1Value = Rng2.Value Then
Rng1.Interior.Color = VBA.RGB(255, 0, 0)
Exit For

End If
Next
Next

End Sub

Как это устроено:

  1. Ответьте на оба поля ввода с соответствующим диапазоном данных из обоих листов для сравнения.
  2. Макрос выделит дубликаты данных на листе 1(Data Sheet) красным цветом.
  3. Запустите нижеприведенный макрос для копирования дубликатов данных.
  4. Скопируйте оба макроса как стандартный модуль.

Отредактировано:

Чтобы избежать использования второго макроса, сделайте следующее:

  1. Выберите диапазон данных в DATA Sheet и примените Auto Filter.
  2. Строки фильтра в красном цвете.
  3. Копировать отфильтрованные строки.
  4. Поместите указатель ячейки в нужную ячейку и примените Pastes Special, затем нажмите Value.

    Sub CopyRedRows()
    
    Dim wks As Worksheet
    Dim wNew As Worksheet
    Dim lRow As Long
    Dim lNewRow As Long
    Dim x As Long
    
    Set wks = Sheets("Data")
    lRow =  wks.Cells.SpecialCells(xlCellTypeLastCell).Row 
    
      Set wNew = Sheets("Summary")
      lNewRow = 10
    
      For x = 1 To lRow
        If wks.Cells(x, 1).Interior.Color = vbRed Then
          wks.Cells(x, 1).EntireRow.Copy wNew.Cells(lNewRow, 1)
          lNewRow = lNewRow + 1
        End If
      Next
    
    End Sub
    
  5. Sheet Name , RGB Color Code и значения lNewRow доступны для редактирования.

Всё ещё ищете ответ? Посмотрите другие вопросы с метками .