如何比较 /insert 来自两个不同列的日期

Question

您好，我是 vba 新手，当我需要比较来自两个不同定价来源的某些证券的价格时，我被困在一个项目中。

excel Col A - E 属于第一个来源，F-I 属于第二个来源，其中 A 和 F 包含日期，B/G C/H D/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

当我运行这个宏时，结果不是我想象的那样......中间有很多随机颜色的空白行..

我对编码完全陌生，所以我可能没有为问题选择最佳结构。知道如何使它工作吗？

Answer 1

在 excel 中，我不建议在源工作表中插入或删除行。最好将每个值复制到新工作表上。

恕我直言，一个好方法是遍历所有日期列表并在源工作表中找到某个日期。这是不太复杂的算法：

一些简单的代码：

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