Как сравнивать/вставлять даты из двух разных столбцов

Question

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

В excel Col A - E относится к первому источнику, а FI принадлежит ко второму источнику, где A и F содержит дату, а B/GC/HD/I содержит ставку, цену, цену закрытия соответственно от даты на A/F, соответственно ...

Что я хочу сравнить, если все даты на A и F совпадают или имеются какие-либо отсутствующие даты.

Если в любом источнике отсутствует какая-либо дата, я хочу вставить отсутствующую дату и выделить отсутствующую дату цветом, и оставить ячейки в B-E/G-I пустыми.

Ниже мой код:

Dim lastRow As Long 
    lastRow = wks.Range("A3").End(xlDown).Row 


    For i = 4 To lastRow Step 1 
     acell = wks.Cells(i, 1).Value 
     fcell = wks.Cells(i, 6).Value 

     If acell <> fcell Then 
      If acell > fcell Then 
      wks.Range("A3:A90", "C3:C90").Rows(i).Insert xlShiftDown 
      wks.Cells(i, 1) = fcell 
      wks.Cells(i, 1).Interior.Color = vbRed 
      End If 

      If fcell > acell Then 
      wks.Range("F3:F90", "I3:I90").Rows(i).Insert xlShiftDown 
      wks.Cells(i, 6) = acell 
      wks.Cells(i, 6).Interior.Color = vbRed 
      End If 
     End If 
    Next i 

Когда я запустил этот макрос результат не то, что у меня есть imagined..There много пустых строк между в случайных цветах ..

I я совершенно новый для кодирования, поэтому я, возможно, не выбрал лучшую структуру для этой проблемы. Любая идея, как я могу заставить ее работать?

Answer 1

В excel я не рекомендую вставлять или удалять строки в исходном листе. Лучше скопируйте каждое значение на новый лист.

IMHO хороший способ перебирать список всех дат и находить определенную дату на исходном листе. Это менее сложный алгоритм:

простой код:

Dim Filled As Boolean 

Set ListWks = ThisWorkbook.Worksheets(1) 
Set SrcWks = ThisWorkbook.Worksheets(2) 
Set DestWks = ThisWorkbook.Worksheets(3) 

DestWks.UsedRange.EntireRow.Clear 

For i = 1 To ListWks.UsedRange.Rows.Count 
    Filled = False 
    For k = 2 To SrcWks.UsedRange.Rows.Count ' k = 1 - header 
     If ListWks.Cells(i, "A").Value = SrcWks.Cells(k, "A").Value Or _ 
     ListWks.Cells(i, "A").Value = SrcWks.Cells(k, "F").Value Then 
      DestWks.Range("A" & i & ":i" & i).Value = SrcWks.Range("A" & k & ":i" & k).Value 
      Filled = True 
      GoTo break_k_loop 
     End If 
    Next k 
break_k_loop: 
    If Not Filled Then DestWks.Cells(i, "A").EntireRow.Interior.Color = vbRed 
Next i 

PS1 Хорошая идея работы с первым источником ("A: E") и второй ("F: I") независимо , Для хорошего просмотра вы можете написать «статус» каждой даты на ListWks. Диапазоны должны быть непрерывными и не забудьте отсортировать их по датам.

If SrcWks.Range("a1") <> "" Then 
    With SrcWks 
     .AutoFilterMode = False 
     .Range("a1:e1").AutoFilter 
    End With 
    With SrcWks.AutoFilter.Sort 
     .SortFields.Clear 
     .SortFields.Add Key:=Range("a1"), SortOn:=xlsortonvalue, Order:=xlAscending, DataOption:=xlSortNormal 
     .Header = xlYes 
     .MatchCase = False 
     .Orientation = xlTopToBottom 
     .SortMethod = xlPinYin 
     .Apply 
    End With 
End If 

Таким образом, полный псевдокод:

clear_destination_wks 

apply_filter_on_first_source 
loop_through_datelist_with_first_source 
    if date_present then 
     copy_range_to_DestWks  
     write_status_on_listWks_for_example_2 
    else 
     write_status_on_listWks_for_example_1 
    end if 

apply_filter_on_second_source 
loop_through_datelist_with_first_source 
    if date_present then 
     copy_range_to_DestWks 
     write_status_on_listWks_for_example_PRESENT 
    elseif status_on_listWks = 1 
     write_status_on_listWks_for_example_NOT_PRESENT 
     DestWks.interior.color = vbRed 
    end if 

clear_all_filters 

PS2: Если по какой-то причине вам нужно использовать так, как вы описали, вы не должны забывать увеличить счетчик и контур, связанный во время вставки строки.

For i = 4 To lastRow 
    If reason = True Then 
     wks.Rows(i).Insert xlShiftDown ' instead Range("A3:A90", "C3:C90") 
     i = i + 1 
     lastRow = lastRow + 1 
    End If 
next i