Найти дубликаты, обновить базу данных с минимальным значением в Excel

Question

`Sub Update_data()

Dim Bk1 As Workbook 
Dim Bk2 As Workbook 
Dim Rng1 As Range 

Workbooks("Book1").Activate 'indicate wb name1 here
Set Bk1 = ActiveWorkbook 
Workbooks("Book2").Activate 'indicate wb name2 here
Set Bk2 = ActiveWorkbook 


Bk1.Activate 
Set Rng1 = Range(Cells(1, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 2)) 

Rng1.Copy 
Cells(1, 26).PasteSpecial Paste:=xlPasteValues 
Cells(1, 26).AutoFilter 
ActiveWorkbook.ActiveSheet.AutoFilter.Sort.SortFields.Add Key:=Rng1.Offset(0, 25), SortOn:=xlSortOnValues, Order:=xlAscending 
Cells(1, 26).AutoFilter 

Rng1.Offset(0, 25).RemoveDuplicates Columns:=1, Header:=xlYes 
Rng1.Offset(1, 25).NumberFormat = "m/d/yyyy" 

Dim i As Integer 

For i = 2 To Cells(Rows.Count, 26).End(xlUp).Row 
    Dim x As String 
    x = Cells(i, 26).Value 
    Bk2.Activate 
    Dim y As Integer 
    On Error Resume Next 
    y = WorksheetFunction.Match(x, Bk2.Worksheets(1).Columns(1)) 
    Bk2.Worksheets(1).Cells(y, 2) = Bk1.Worksheets(1).Cells(i, 27) 

    Bk1.Activate 
Next i 

Rng1.Offset(0, 25).ClearContents`

Пожалуйста, помогите мне с макросом VBA для достижения ниже.

У меня есть две рабочие тетради - Рабочая тетрадь 1 и Рабочая тетрадь 2

WB 1 - это место, где вводятся данные. WB 2 - это база данных. (В этом ВБ нет дубликатов)

From WB1 Если в столбце A есть дубликаты, проверьте, является ли соответствующее значение в столбце B минимальным значением дубликатов.

Затем скопируйте соответствующие ячейки A & B, в которых B имеет минимальное значение, наряду с другими данными в столбце A & B и сопоставьте столбец A WB1 с столбцом A WB 2, если совпадение найдено, затем вставьте минимальное значение, найденное среди дубликатов в столбце B WB1 в столбец B WB2 вместе с другими исходными данными в столбцах A и B в WB1.

Мне удалось достичь вышеизложенного с помощью прилагаемого кода, созданного MAX,

но обнаружил небольшую ошибку при тестировании. Если WB 2 (база данных) находится в порядке возрастания, то макрос работает хорошо, но если WB2 (база данных) не в порядке или перемешан, то он оставляет пустыми некоторые ячейки в столбце B WB 2.

Также я попытался ввести данные без дубликатов в WB1 (сбор данных, столбец A), и они вернулись с неверными данными (дата - столбец B) в WB2.

Я приложил пример изображения для вашего обзора.

[ https://www.dropbox.com/s/0vq76uvzs2rav3q/NIHL%20data%20Capturesample.xls?dl=0]

Answer 1

Как уже говорилось в комментариях @teylyn, мы не являемся сервисом написания кода. И чтобы добавить к этому, ваш код беспорядок. Я постараюсь дать вам несколько советов и надеюсь побудить вас переписать свой код самостоятельно.

• Dim используется для объявления переменных. Поместите все Dim заявления вверху.
• Попытайтесь понять, что делает ваш код, и удалите весь дублирующий / нефункциональный / повторяющийся код

• Прочитайте документацию Microsoft Technet о функциях, которые вы используете. Для функции Match это ясно заявляет:

  "Функция MATCH найдет наибольшее значение, которое меньше или равно значению. Вы должны быть уверены, что отсортировали массив в порядке возрастания. "

• Поместите несколько комментариев над каждым разделом вашего кода (каждые 3-8 строк кода), объясняя, что он делает.

• Не используйте .Activate для переключения между книгами. Поскольку вы определили два объекта Workbook , вы можете получить доступ к данным на листе через WorkbookObject.Range(<etc.>) . Это делает ваш код намного быстрее и скрывает переключение рабочих книг для пользователя, который нажимает кнопку.