比较Excel

Question

我对股票进行季度报告比较。报告中的每个项目都有一个参考编号，然后是几个数据点（A列有参考，然后是B - ＆gt;＆gt;）具有数据特征。

我希望能够快速比较两个报告中的列，并检查两个三项内容，添加内容（第二个报告中的项目不在第一个报告上），删除（第一个报告中的项目但不是第二个报告上的项目）和更改（两个报告中的项目，但我正在检查的列中的值已更改。

好主意......

好的，所以我把一个很有效的字典构建器放在一起：

Function CreateStockDictionary(wsNAME As String, refColumn As String, TargetColumn As String, startRow As Long)

Dim dict As Scripting.Dictionary
Set dict = New Scripting.Dictionary
dict.CompareMode = vbTextCompare 'NON case sensitive

Dim xRange As Range
Dim xCell As Range

Dim EndRow As Long
EndRow = FindLastRow(wsNAME)

Dim RefString As String
Dim TargString As String

RefString = GetRangstring(refColumn, startRow, refColumn, EndRow)
TargString = GetRangstring(TargetColumn, startRow, TargetColumn, EndRow)

Set xRange = Application.Union(Worksheets(wsNAME).Range(RefString), Worksheets(wsNAME).Range(TargString))

i = 1
For i = 1 To EndRow
    dict.Add Key:=xRange(i, 1), Item:=xRange(i, 2)
Next i

Set CreateStockDictionary = dict
Set dict = Nothing

End Function

所以上面会返回一个包含我需要的所有东西的字典。基本上，参考编号已成为关键。并且另一列中的数据值已成为项目。所以我写了一个脚本，我认为它会比较使用上面创建的两个词典：

Sub sbCompareDictionary()

Const wsNameSOY As String = "TEST"
Const wsNameQ1 As String = "TEST2"
Const refColumn As String = "A"
Const compareColumn As String = "B"
Const startRow As Long = 1

Dim returnArray As Variant

Dim SOYDict As Scripting.Dictionary
Set SOYDict = CreateStockDictionary(wsNameSOY, refColumn, compareColumn, startRow)

Dim Q1Dict As Scripting.Dictionary
Set Q1Dict = CreateStockDictionary(wsNameQ1, refColumn, compareColumn, startRow)

Dim OutputDict As Scripting.Dictionary
Set OutputDict = New Scripting.Dictionary


' Check for entries not in both (1st dictionary against 2nd)
For Each xkey In SOYDict.Keys

    If Not Q1Dict.Exists(xkey) Then 'If it doesnt exist in both then flag as missing
        OutputDict.Add xkey, "Not found in " & wsNameQ1
    End If

    If Q1Dict.Exists(xkey) Then ' If it does exist then check for changes
        If SOYDict.Items(xkey) <> Q1Dict.Items(xkey) Then
            OutputDict.Add xkey, "Value has Changed from [" & SOYDict.Items(xkey) & "] To [" & Q1Dict.Items(xkey) & "]"
        End If
    End If

Next xkey


ReDim returnArray(OutputDict.Count, 2)

Counter = 0
For Each Key In OutputDict.Keys
    returnArray(Counter, 0) = Key
    returnArray(Counter, 1) = OutputDict.Item(Key)
    Counter = Counter + 1
Next Key

Set Destination = Worksheets(wsNameSOY).Range("k1")
Destination.Resize(UBound(returnArray, 1), UBound(returnArray, 2)).Value = returnArray

End Sub

此处似乎没有问题：

' Check for entries not in both (1st dictionary against 2nd)
For Each xkey In SOYDict.Keys

    If Not Q1Dict.Exists(xkey) Then 'If it doesnt exist in both then flag as missing
        OutputDict.Add xkey, "Not found in " & wsNameQ1
    End If

    If Q1Dict.Exists(xkey) Then ' If it does exist then check for changes
        If SOYDict.Items(xkey) <> Q1Dict.Items(xkey) Then
            OutputDict.Add xkey, "Value has Changed from [" & SOYDict.Items(xkey) & "] To [" & Q1Dict.Items(xkey) & "]"
        End If
    End If

Next xkey

我尝试了很多变化，但由于某些原因，我似乎无法从Q1Dict返回值

我设置表1：

1   A
2   B
3   C
4   D
5   E

和第2页

1   A
2   B
3   C
4   D
5   F
6   E

所以我应该在第一张和第五张上失去6，但是它只是不起作用。

我花了好几个小时试图找出原因......请，请...帮助！

Answer 1

迟到总比没有 - 看起来像检查不在两者中的条目，你需要添加＆＃39; .value ＆＃39;你的存在和添加方法......像这样：

If Not Q1Dict.Exists(xkey.value) Then 'If it doesn't exist in both then flag as missing
    OutputDict.Add xkey.value, "Not found in " & wsNameQ1
End If