Compare Excel worksheets

已取消 已发布的 Mar 21, 2009 货到付款
已取消 货到付款

I need a Excel macro that will compare 2 worksheets.? The results of the comparison will be displayed on a third worksheet.? I've downloaded some? vb source code that works almost to my specifications.? It should serve as a good starting point. The macro should be able to compare two worksheets with several thousand rows each.

## Deliverables

This code will compare 2 Excel worksheets and place the differences on a third worksheets.

*Sub CompareWorksheets(ws1 As Worksheet, ws2 As Worksheet)

Dim r As Long, c As Integer

Dim lr1 As Long, lr2 As Long, lc1 As Integer, lc2 As Integer

Dim maxR As Long, maxC As Integer, cf1 As String, cf2 As String

Dim rptWB As Workbook, DiffCount As Long

? ? ? [url removed, login to view] = False

? ? ? [url removed, login to view] = "Creating the report..."

? ? ? Set rptWB = [url removed, login to view]

? ? ? [url removed, login to view] = False

? ? ? While [url removed, login to view] > 1

? ? ? ? ? ? ? Worksheets(2).Delete

? ? ? Wend

? ? ? [url removed, login to view] = True

? ? ? With [url removed, login to view]

? ? ? ? ? ? ? lr1 = .[url removed, login to view]

? ? ? ? ? ? ? lc1 = .[url removed, login to view]

? ? ? End With

? ? ? With [url removed, login to view]

? ? ? ? ? ? ? lr2 = .[url removed, login to view]

? ? ? ? ? ? ? lc2 = .[url removed, login to view]

? ? ? End With

? ? ? maxR = lr1

? ? ? maxC = lc1

? ? ? If maxR < lr2 Then maxR = lr2

? ? ? If maxC < lc2 Then maxC = lc2

? ? ? DiffCount = 0

? ? ? For c = 1 To maxC

? ? ? ? ? ? ? [url removed, login to view] = "Comparing cells " & Format(c / maxC, "0 %") & "..."

? ? ? ? ? ? ? For r = 1 To maxR

? ? ? ? ? ? ? ? ? ? ? cf1 = ""

? ? ? ? ? ? ? ? ? ? ? cf2 = ""

? ? ? ? ? ? ? ? ? ? ? On Error Resume Next

? ? ? ? ? ? ? ? ? ? ? cf1 = [url removed, login to view](r, c).FormulaLocal

? ? ? ? ? ? ? ? ? ? ? cf2 = [url removed, login to view](r, c).FormulaLocal

? ? ? ? ? ? ? ? ? ? ? On Error GoTo 0

? ? ? ? ? ? ? ? ? ? ? If cf1 <> cf2 Then

? ? ? ? ? ? ? ? ? ? ? ? ? ? ? DiffCount = DiffCount + 1

? ? ? ? ? ? ? ? ? ? ? ? ? ? ? Cells(r, c).Formula = "'" & cf1 & " <> " & cf2

? ? ? ? ? ? ? ? ? ? ? End If

? ? ? ? ? ? ? Next r

? ? ? Next c

? ? ? [url removed, login to view] = "Formatting the report..."

? ? ? With Range(Cells(1, 1), Cells(maxR, maxC))

? ? ? ? ? ? ? .[url removed, login to view] = 19

? ? ? ? ? ? ? With .Borders(xlEdgeTop)

? ? ? ? ? ? ? ? ? ? ? .LineStyle = xlContinuous

? ? ? ? ? ? ? ? ? ? ? .Weight = xlHairline

? ? ? ? ? ? ? End With

? ? ? ? ? ? ? With .Borders(xlEdgeRight)

? ? ? ? ? ? ? ? ? ? ? .LineStyle = xlContinuous

? ? ? ? ? ? ? ? ? ? ? .Weight = xlHairline

? ? ? ? ? ? ? End With

? ? ? ? ? ? ? With .Borders(xlEdgeLeft)

? ? ? ? ? ? ? ? ? ? ? .LineStyle = xlContinuous

? ? ? ? ? ? ? ? ? ? ? .Weight = xlHairline

? ? ? ? ? ? ? End With

? ? ? ? ? ? ? With .Borders(xlEdgeBottom)

? ? ? ? ? ? ? ? ? ? ? .LineStyle = xlContinuous

? ? ? ? ? ? ? ? ? ? ? .Weight = xlHairline

? ? ? ? ? ? ? End With

? ? ? ? ? ? ? On Error Resume Next

? ? ? ? ? ? ? With .Borders(xlInsideHorizontal)

? ? ? ? ? ? ? ? ? ? ? .LineStyle = xlContinuous

? ? ? ? ? ? ? ? ? ? ? .Weight = xlHairline

? ? ? ? ? ? ? End With

? ? ? ? ? ? ? With .Borders(xlInsideVertical)

? ? ? ? ? ? ? ? ? ? ? .LineStyle = xlContinuous

? ? ? ? ? ? ? ? ? ? ? .Weight = xlHairline

? ? ? ? ? ? ? End With

? ? ? ? ? ? ? On Error GoTo 0

? ? ? End With

? ? ? Columns("A:IV").ColumnWidth = 20

? ? ? [url removed, login to view] = True

? ? ? If DiffCount = 0 Then

? ? ? ? ? ? ? [url removed, login to view] False

? ? ? End If

? ? ? Set rptWB = Nothing

? ? ? [url removed, login to view] = False

? ? ? [url removed, login to view] = True

? ? ? MsgBox DiffCount & " cells contain different formulas!", vbInformation, _

? ? ? ? ? ? ? "Compare " & [url removed, login to view] & " with " & [url removed, login to view]

End Sub*

*This example macro shows how to use the macro above:

Sub TestCompareWorksheets()

? ? ? ' compare two different worksheets in the active workbook

? ? ? CompareWorksheets Worksheets("Sheet1"), Worksheets("Sheet2")

? ? ? ' compare two different worksheets in two different workbooks

? ? ? CompareWorksheets [url removed, login to view]("Sheet1"), _

? ? ? ? ? ? ? Workbooks("[url removed, login to view]").Worksheets("Sheet2")

End Sub*

The two worksheests that I will be using has thousands of rows of data each.? Worksheet1 will? consist of new data and Worksheet2 will be made of original data.

?

I would like the code to do the following:

INPUT:? 2 worksheets with 33 columns each.? Worksheet1 can have anywhere between 1 and several thousand rows.? Worksheet2 will normally have several thousand rows.? Focus should be on 4 specific columns: Action, bank_No, Code, and program.? 'Action' will only be populated in worksheet1 with the values add, remove, or update

1.? Sort worksheet1 by ‘Action’

2.? If [url removed, login to view] = ‘Add’, then?

? ? ? ? ? ? ? ? 1. Read Worksheet1.(No, Code, Program)?

? ? ? ? ? ? ? ? 2.? Search Worksheet2 for Worksheet1.(No, Code, Program)?

? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? i.? If found, SUB FOUND( )?

? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ii.? If not found, SUB NOT FOUND ( )

? ? ? ? If [url removed, login to view] = ‘Remove’, then?

? ? ? ? ? ? ? ? 1.? Read Worksheet1.(No, Code, Program)?

? ? ? ? ? ? ? ? 2.? Search Worksheet2 for Worksheet1.(No, Code, Program)?

? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? iii. If found,?

? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? 1.? Copy entire row to worksheet3?

? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? 2. update [url removed, login to view] to ‘NOT REMOVED’?

? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? 3.? highlight row in red?

? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? iv.? If not found?

? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? 1.? Copy entire row to worksheet3?

? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? 2.? update [url removed, login to view] to ‘REMOVED’?

? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? 3.? highlight row light blue

? ? ? ? If [url removed, login to view] = ‘Update’, then?

? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? 1.? Read Worksheet1.(No, Code, Program)?

? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? 2.? Search Worksheet2 for Worksheet1.(No, Code, Program)?

? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? v.? ? If found, SUB FOUND( )?

? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? vi.? If not found, SUB NOT FOUND ( )

SUB FOUND ( )

1.? Compare each cell

2.? If cells are identical and [url removed, login to view] = ‘Add’?

? ? ? ? ? ? ? ? i.? ? Copy the row from worksheet1 to worksheet3?

? ? ? ? ? ? ? ? ii.? ? Change [url removed, login to view] to ‘ADDED’?

? ? ? ? ? ? ? ? iii.? Highlight row light green

3.? ? If cells are identical and [url removed, login to view] = ‘Update’?

? ? ? ? ? ? ? ? i.? Compare each cell from worksheet1 with worksheet2?

? ? ? ? ? ? ? ? ? ? ? ? 1.? ? If identical:?

? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? a.? Copy the row from worksheet1 to worksheet3?

? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? b.? Change [url removed, login to view] to ‘UPDATED’?

? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? c.? Highlight row light yellow

4.? ? If one or more cells do not match:?

? ? ? ? ? ? ? ? ? ? ? ? a.? ? Copy the row from worksheet1 to worksheet3?

? ? ? ? ? ? ? ? ? ? ? ? b.? ? Bold the different cells?

? ? ? ? ? ? ? ? ? ? ? ? c.? ? ? Highlight row in red?

? ? ? ? ? ? ? ? ? ? ? ? d.? ? ? Change [url removed, login to view] to ‘UPDATE ERROR’

SUB NOT FOUND ( )

1.? Copy the row from worksheet1 to worksheet3

2.? Change [url removed, login to view] to ‘MISSING’

3.? Highlight row light red

?

工程 MySQL PHP 项目管理 软件构架 软件测试

项目ID: #3747897

关于项目

6个方案 远程项目 活跃的Mar 25, 2009

有6名威客正在参与此工作的竞标,均价$8/小时

bob1982

See private message.

$8.5 USD 在2天内
(366条评论)
7.0
velocityinf

See private message.

$6.8 USD 在2天内
(17条评论)
3.7
vw7195038vw

See private message.

$6.8 USD 在2天内
(4条评论)
2.3
satheez1984

See private message.

$6.8 USD 在2天内
(2条评论)
2.3
Abikris

See private message.

$8.5 USD 在2天内
(1条评论)
0.5
tvnvw

See private message.

$8.5 USD 在2天内
(0条评论)
0.0