嗨,我是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
当我运行这个宏时,结果不是我想象的那样。中间有很多空行以随机颜色显示..
我对编码完全陌生,所以我可能没有为问题选择最佳结构。任何想法我怎么能让它工作?
答案 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