我希望比较两个工作簿之间的更改。
数据看起来像这样
工作簿1:
//@version=4
strategy("bnf2")
entryTime = year == 2019 and month == 8 and hour == 14 and minute == 0
exitTime = year == 2019 and month == 8 and hour == 15 and minute == 15
strategy.entry("bnf-long", strategy.long, 20, stop= high, when=entryTime)
strategy.close("bnf-long", when = exitTime)
plot(strategy.equity)
工作簿2:
Column1 Column 2 Column 3
Nissan Micra Red
Honda CRV Grey
Honda Accord Grey
我想在遍历每一行时识别列之间的变化。
例如,代码应标识/输出在第2行中,第2列和第3列之间有变化,在第3行中,第1列和第2列之间有变化。
答案 0 :(得分:0)
现在回答您的问题有点困难,因为您没有提供任何初步代码或希望如何进行比较的详细信息(通过MsgBox,Debug.Print,生成.xlsx或。 txt文件等)。
幸运的是,这看起来与我过去要做的事情类似,因此我有一个代码示例可以与您分享,可以帮助您入门。
要运行该示例,只需将下面的代码(1个子过程和2个函数)粘贴到模块中,然后运行该子过程。
Public Sub CompareWorkbooks()
'PURPOSE: Compare the sheets with the same name in two workbooks to make sure all the values are the same.
'Select the 2 files manually
Dim WbName1 As String, WbName2 As String
WbName1 = UserSelectWorkbook
WbName2 = UserSelectWorkbook
'Open the 2 files if they are not open
Dim FullFileName As String
Dim temp() As String
Dim FileName As String
FullFileName = WbName1
temp = Split(FullFileName, "\")
FileName = temp(UBound(temp))
Dim wb1 As Workbook, wb2 As Workbook
If IsWorkbookOpen(FileName) = False Then
Set wb1 = Workbooks.Open(FullFileName)
Else
Set wb1 = Workbooks(FileName)
End If
FullFileName = WbName2
temp = Split(FullFileName, "\")
FileName = temp(UBound(temp))
If IsWorkbookOpen(FileName) = False Then
Set wb2 = Workbooks.Open(FullFileName)
Else
Set wb2 = Workbooks(FileName)
End If
'Compare the 2 files
Dim DifferenceFoundInWorkbook As Boolean
Dim ws1 As Worksheet, ws2 As Worksheet
For Each ws1 In wb1.Worksheets
For Each ws2 In wb2.Worksheets
If ws1.Name = ws2.Name Then
Dim Range1 As Range, Range2 As Range
Set Range1 = ws1.UsedRange
Set Range2 = ws2.UsedRange
Dim DifferenceFoundWithinSheets As Boolean
DifferenceFoundWithinSheets = False 'Reset
Dim CellNumber As Long
CellNumber = 0 'Reset
Dim c As Range
For Each c In Range1
CellNumber = CellNumber + 1
If c.Value2 <> Range2.Cells(CellNumber).Value2 Then
Dim DoContinue As Variant
DoContinue = MsgBox("Different values in " & vbNewLine & _
"[" & wb1.Name & "]" & ws1.Name & "!" & c.Address & " (""" & Range1.Cells(CellNumber).Value2 & """)" & vbNewLine & _
"[" & wb2.Name & "]" & ws2.Name & "!" & c.Address & " (""" & Range2.Cells(CellNumber).Value2 & """)" & vbNewLine & vbNewLine & _
"Continue searching?", _
vbYesNoCancel, "Workbook Comparison")
DifferenceFoundWithinSheets = True
DifferenceFoundInWorkbook = True
Select Case DoContinue
Case Is = vbYes: 'Let the comparison continue
Case Is = vbNo: Exit Sub
Case Is = vbCancel: Exit Sub
Case Else: Exit Sub 'For when the user press the X in the top righ corner.
End Select
End If
Next c
If Not DifferenceFoundWithinSheets Then
MsgBox "No difference found between the 2 worksheets with name " & ws1.Name
End If
End If
Next ws2
Next ws1
If Not DifferenceFoundInWorkbook Then
MsgBox "No difference found between the 2 workbooks."
End If
End Sub
Public Function UserSelectWorkbook() As String
'PURPOSE: Allows to select one workbook using the usual window.
'SOURCE: https://excelmacromastery.com/excel-vba-workbook/
On Error GoTo ErrorHandler
Dim FD As FileDialog
Set FD = Application.FileDialog(msoFileDialogFilePicker)
' Open the file dialog
With FD
' Set Dialog Title
.Title = "Please Select File"
' Add filter
.Filters.Add "Excel Files", "*.xls;*.xlsx;*.xlsm;*.xlsb;*.csv"
' Allow selection of one file only
.AllowMultiSelect = False
' Display dialog
.Show
If FD.SelectedItems.Count <> 0 Then
UserSelectWorkbook = FD.SelectedItems(1)
Else
MsgBox "Selecting a file has been cancelled. "
UserSelectWorkbook = vbNullString
End If
End With
CleanUp:
Set FD = Nothing
Exit Function
ErrorHandler:
MsgBox "Error: " & Err.Description
GoTo CleanUp
End Function
Public Function IsWorkbookOpen(ByVal FullFileName As String) As Boolean
Dim wb As Workbook
Dim ErrNb As Long
On Error Resume Next
Set wb = Workbooks(FullFileName)
ErrNb = Err.Number
On Error GoTo 0
Select Case ErrNb
Case 0: IsWorkbookOpen = True
Case Else: IsWorkbookOpen = False
End Select
End Function
此代码将为您提供每个发现的差异的MsgBox窗口。您可能希望将其更改为将产生这些差异的列表并将其写入工作表的命令。
还请注意,此宏没有任何错误处理,并且没有针对在大型工作簿上运行进行优化。
如果要将报告生成到新工作簿中,则可以使用其他版本的CompareWorkbooks
宏:
Public Sub CompareWorkbooks()
'PURPOSE: Compare the sheets with the same name in two workbooks and generate a summary in a new workbook.
'Select the 2 files manually
Dim WbName1 As String, WbName2 As String
WbName1 = UserSelectWorkbook
WbName2 = UserSelectWorkbook
'Open the 2 files if they are not open
Dim FullFileName As String
Dim temp() As String
Dim FileName As String
FullFileName = WbName1
temp = Split(FullFileName, "\")
FileName = temp(UBound(temp))
Dim wb1 As Workbook, wb2 As Workbook
If IsWorkbookOpen(FileName) = False Then
Set wb1 = Workbooks.Open(FullFileName)
Else
Set wb1 = Workbooks(FileName)
End If
FullFileName = WbName2
temp = Split(FullFileName, "\")
FileName = temp(UBound(temp))
If IsWorkbookOpen(FileName) = False Then
Set wb2 = Workbooks.Open(FullFileName)
Else
Set wb2 = Workbooks(FileName)
End If
'Compare the 2 files
Dim DifferenceFoundInWorkbook As Boolean
Dim ws1 As Worksheet, ws2 As Worksheet
For Each ws1 In wb1.Worksheets
For Each ws2 In wb2.Worksheets
If ws1.Name = ws2.Name Then
Dim Range1 As Range, Range2 As Range
Set Range1 = ws1.UsedRange
Set Range2 = ws2.UsedRange
Dim DifferenceFoundWithinSheets As Boolean
DifferenceFoundWithinSheets = False 'Reset
Dim CellNumber As Long
CellNumber = 0 'Reset
Dim c As Range
For Each c In Range1
CellNumber = CellNumber + 1
If c.Value2 <> Range2.Cells(CellNumber).Value2 Then
Dim Counter As Long
Dim wbReport As Workbook
If Counter = 0 Then
Set wbReport = Workbooks.Add
End If
Counter = Counter + 1
wbReport.ActiveSheet.Cells(Counter, 1).Value2 = "[" & wb1.Name & "]" & ws1.Name & "!" & c.Address & " (""" & Range1.Cells(CellNumber).Value2 & """)"
wbReport.ActiveSheet.Cells(Counter, 2).Value2 = "[" & wb2.Name & "]" & ws2.Name & "!" & c.Address & " (""" & Range2.Cells(CellNumber).Value2 & """)"
DifferenceFoundInWorkbook = True
End If
Next c
End If
Next ws2
Next ws1
If Not DifferenceFoundInWorkbook Then
MsgBox "No difference found between the 2 workbooks."
End If
End Sub