Добавьте код для сравнения дат, затем запустите макрос для соответствия столбцам - PullRequest
Новая
       52

Добавьте код для сравнения дат, затем запустите макрос для соответствия столбцам

0 голосов
/ 25 сентября 2019

Sheet1 накапливает рабочие места с рекомендациями в течение года.Лист 2 накапливает выполненные рекомендации.Любая строка на Листе 1 без совпадения должна отслеживаться.Дубликаты появляются, как указано в строке 14. Поскольку работа в строке 14 выполнялась 24.01.199, рекомендация не могла быть выполнена до этой даты.Вот код, который я использую для MatchColums; 

Sub MatchColums()

Dim i, total, fRow As Integer
Dim found As Range

total = Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row

For i = 1 To total
    answer1 = Worksheets(1).Range("C" & i).Value
 Set found = Worksheets(2).Columns("C:C").Find(what:=answer1) 'finds a match

If found Is Nothing Then
    Worksheets(1).Range("H" & i).Value = "NO MATCH"
Else
    fRow = Sheets(2).Columns("C:C").Find(what:=answer1).Row
    Worksheets(1).Range("I" & i).Value = Worksheets(2).Range("A" & fRow).Value
    Worksheets(1).Range("J" & i).Value = Worksheets(2).Range("B" & fRow).Value
    Worksheets(1).Range("K" & i).Value = Worksheets(2).Range("C" & fRow).Value
    Worksheets(1).Range("L" & i).Value = Worksheets(2).Range("D" & fRow).Value
    Worksheets(1).Range("M" & i).Value = Worksheets(2).Range("E" & fRow).Value
    Worksheets(1).Range("N" & i).Value = Worksheets(2).Range("F" & fRow).Value
    Worksheets(1).Range("O" & i).Value = Worksheets(2).Range("G" & fRow).Value

 End If
 Next i

End Sub

Я добавил следующий код для предотвращения дублирования; 

Sub CompareDates()

If Sheet1.Range("A1") < Sheet2.Range("A1") Then
Run "MatchColums"
End If
End Sub

Я не получаю никаких сообщений об ошибках, нопохоже, что мой макрос CompareDates не работает.Я попытался запустить макрос matchcolums 1-й, но снова у меня тот же результат, как показано ниже:

enter image description here

Я очень начинающий пользователь, поэтому любойприветствуется помощь.

Вот копия Листа 2

введите описание изображения здесь

1 Ответ

0 голосов
/ 26 сентября 2019

Эти две строки делают одно и то же 

Dim i, total, fRow As Integer 

Dim i As Variant, total As Variant, fRow As Integer

  • К Dim как Integer

    Dim i As Integer, total As Integer, fRow As Integer

Похоже, он всегда оценивается как "1", если только Column A не имеет пустых ячеек, так как функционирует ваша For петля 

`total = Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row`

Find возвращает только первое совпадение 

`Set found = Worksheets(2).Columns("C:C").Find(what:=answer1)`

  • Не похоже, что вы ищете уникальные значения,В ваших образцах данных «Фамилия» указана в Column C, а «Мосс» появляется в разное время в Shhet1, но ваша функция Find вернет только первое вхождение «Мосс» в Sheet2.Это означает, что первый «Мох» в Sheet2 будет записан для каждого «Мха» в Sheet1.Так что вы получаете ложные срабатывания и плохие совпадения.Это видно из вашего вывода: вы не предоставили образец Sheet2, но я знаю, что первое появление слова «Мосс» - это «Номер задания 13774» в «18.12.2008», потому что оно записано несколько раз в Sheet1.Чтобы решить эту проблему, используйте Find с уникальными значениями или найдите каждое совпадение и сравните даты, номера заданий и т. Д., Пока не получите правильное значение.

  • Вы прошли квалификацию своих диапазоновдо уровня листа, но Rows.Count не является квалифицированным.

Этот блок может быть сокращен до одной строки 

`Worksheets(1).Range("I" & i).Value = Worksheets(2).Range("A" & fRow).Value`
`Worksheets(1).Range("J" & i).Value = Worksheets(2).Range("B" & fRow).Value`
`Worksheets(1).Range("K" & i).Value = Worksheets(2).Range("C" & fRow).Value`
`Worksheets(1).Range("L" & i).Value = Worksheets(2).Range("D" & fRow).Value`
`Worksheets(1).Range("M" & i).Value = Worksheets(2).Range("E" & fRow).Value`
`Worksheets(1).Range("N" & i).Value = Worksheets(2).Range("F" & fRow).Value`
`Worksheets(1).Range("O" & i).Value = Worksheets(2).Range("G" & fRow).Value`

Worksheets(1).Range("I" & i ":O" & i) = Worksheets(2).Range("A" & fRow & ":G" & fRow)

...