如何比较/插入两个不同列的日期

时间:2015-06-21 21:17:12

标签: vba excel-vba date comparison excel

嗨,我是vba的新手,当我需要比较来自两个不同定价来源的某些安全性的价格时,我陷入了一个项目。

在excel Col A-E属于第一个来源,FI属于第二个来源,其中A和F包含日期,而B / GC / HD / I分别包含bid,ask,close price 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

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

我对编码完全陌生,所以我可能没有为问题选择最佳结构。任何想法我怎么能让它工作?

1 个答案:

答案 0 :(得分:0)

在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 一个好主意是使用第一个源(&#34; A:E&#34;)和第二个(&#34; F:I&#34;)独立。为了更好的观点,你可以写&#34; status&#34; 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