在本文中,我们将创建一个用户表单来比较两个范围并找出不匹配的单元格。

原始数据包括目标模型和所需模型的数据。我们要查找目标模型和所需模型不匹配的那些记录。

ArrowRawData

我们创建了一个接受两个范围作为输入的用户窗体。比较这两个范围以找到不匹配的单元格。

ArrowUserform

单击提交按钮后,它将比较两个范围并返回输出。它将显示一个消息框,显示不匹配的单元格计数。

ArrowOutput1

它还将在新工作簿中提供不匹配单元格上的数据。

ArrowOutput2

代码说明

设置Rng1 = Range(UserForm3.RefEdit1)

上面的代码用于创建一个范围对象的对象,该对象从用户窗体获取范围值。

如果Rng1什么都不是或Rng2什么都不是,则退出Sub上面的代码用于检查两个范围是否都包含值。如果任何范围都留为空白,则它将跳过该过程中的其余代码。

使用Rng1时LR1 = .Rows.Count LC1 = .Columns.Count结尾使用上面的代码用于获取范围内的行数和列数。

CellValue1 = Rng1.Cells(r,c).FormulaLocal上面的代码用于获取r行和c列的单元格中的值。

如果CellValue1 <> CellValue2然后上面的代码用于比较变量CellValue1和CellValue2中的值。

请遵循以下代码

Option Explicit

Sub CallingUserform()

UserForm3.Show

End Sub

'Insert below code in userform

Option Explicit

Private Sub CommandButton1_Click()

'Declaring variables

Dim Rng1, Rng2 As Range

Dim r, DiffCount As Long, c As Integer

Dim LR1 As Long, LC1 As Integer

Dim CellValue1 As String, CellValue2 As String

Dim NewWB As Workbook

'Getting the two range set for comparing

Set Rng1 = Range(UserForm3.RefEdit1)

Set Rng2 = Range(UserForm3.RefEdit2)

'Unloading the userform

Unload Me

'Disabling screen updates

Application.ScreenUpdating = False

'Checking whether Rng1 and Rng2 contains value

If Rng1 Is Nothing Or Rng2 Is Nothing Then Exit Sub

'Getting count of number of rows and columns in Rng1

With Rng1

LR1 = .Rows.Count

LC1 = .Columns.Count

End With

DiffCount = 0

'Adding new workbook for output

Set NewWB = Workbooks.Add



'Looping through all the columns and rows in the range

For c = 1 To LC1

For r = 1 To LR1



'Getting value from particular cell from both the ranges

CellValue1 = Rng1.Cells(r, c).FormulaLocal

CellValue2 = Rng2.Cells(r, c).FormulaLocal



'Comparing value of cell from both ranges

If CellValue1 <> CellValue2 Then



'Getting count of numbers of cells with different values

DiffCount = DiffCount + 1



'Adding unequal values to new workbook

Cells(r, c).Value = "'" & CellValue1 & " <> " & CellValue2

End If



Next r

Next c

'Display count of unequal cells in both range

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

vbInformation, "Compare Worksheet Ranges"

'Enabling screen updates

Application.ScreenUpdating = True

Set NewWB = Nothing



End Sub

如果您喜欢此博客,请在Facebook和Facebook上与您的朋友分享。

我们希望收到您的来信,请让我们知道如何改善我们的工作并为您做得更好。写信给我们[email protected]