出成率的计算公式Excel数据报表对比公式(VBA)

2020年9月29日发(作者：裘翰兴)


公式1：比较两个表空间是否相同BVA（Alt + F11）（BVA）：
Sub 数据对比()
' Date:2015-01-10
' author:FashionSUN
Dim showL, same1, same2, to1, to2, to3, to4, to5, to6 As Integer
Dim shet1, shet2 As String
shet1 = 工作表空间一：
shet2 = 工作表空间二：
showL = 25 '标记列
same1 = 2 '相同列一
same2 = 3 '相同列二（没有的话 128）
to1 = 6 '工作表空间一行数开始
to2 = 250 '工作表空间一行数结束
to3 = 6 '工作表空间二行数开始
to4 = 250 '工作表空间二行数结束
to5 = 4 '对比列开始
to6 = 23 '对比列结束
'程序开始
Dim i, j, k As Integer
For i = to1 To to2 '报表数据范围
For j = to3 To to4 '报表数据范围
If Trim(Sheets(shet1).Cells(i, same1)) = Trim(Sheets(shet2).Cells(j, same1)) And
Trim(Sheets(shet1).Cells(i, same1)) <> 小计第一列相同
If Trim(Sheets(shet1).Cells(i, same2)) = Trim(Sheets(shet2).Cells(j, same2)) And
Trim(Sheets(shet2).Cells(j, same2)) <> 小计第二列相同
Sheets(shet1).Cells(i, showL) = j '存在时进行标记
Sheets(shet2).Cells(j, showL) = i '存在时进行标记
For k = to5 To to6
If Trim(Sheets(shet1).Cells(i, k)) <> Trim(Sheets(shet2).Cells(j, k)) Then
With Sheets(shet1).Cells(i, k).Font
'.Color = RGB(255, 0, 0)
.Bold = True
End With
With Sheets(shet1).Cells(i, k).Interior
.Color = RGB(255, 0, 0)
End With
With Sheets(shet2).Cells(j, k).Font
'.Color = RGB(255, 0, 0)
.Bold = True
End With
With Sheets(shet2).Cells(j, k).Interior
.Color = RGB(255, 0, 0)
End With
End If
Next k
End If
End If
Next j
Next i
End Sub





公式2：比较两个表空间是否相同BVA（Alt + F11）（BVA）：
Sub 数据对比()
' Date:2015-01-10
' author:FashionSUN
Dim showL, same1, same2, to1, to2, to3, to4, to5, to6 As Integer
Dim shet1, shet2, rtnText As String
shet1 = 新工作表空间一：
shet2 = 旧工作表空间二：
same1 = 1 '相同列一
same2 = 2 '相同列二（没有的话 128）
to1 = 1 '工作表空间一行数开始
to2 = 2 '工作表空间一行数结束
to3 = 1 '工作表空间二行数开始
to4 = 3 '工作表空间二行数结束
to5 = 3 '对比列开始
to6 = 11 '对比列结束
showL = 13 '标记列
rtnText = 对比结果换行 vbCrLf ps: rtnText = vbCrLf
'程序开始
Dim i, j, k As Integer
For i = to1 To to2 '报表数据范围
For j = to3 To to4 '报表数据范围
If Trim(Sheets(shet1).Cells(i, same1)) = Trim(Sheets(shet2).Cells(j, same1)) And
Trim(Sheets(shet1).Cells(i, same1)) <> 小计第一列相同
If Trim(Sheets(shet1).Cells(i, same2)) = Trim(Sheets(shet2).Cells(j, same2)) And
Trim(Sheets(shet2).Cells(j, same2)) <> 小计第二列相同
Sheets(shet1).Cells(i, showL) = j '存在时进行标记
Sheets(shet2).Cells(j, showL) = i '存在时进行标记
For k = to5 To to6
If Trim(Sheets(shet1).Cells(i, k)) <> Trim(Sheets(shet2).Cells(j, k)) Then
Dim diff1, diff2 As String
diff1 = Sheets(shet1).Cells(i, k) & rtnText & & shet2 & &
Sheets(shet2).Cells(j, k) &
diff2 = Sheets(shet2).Cells(j, k) & rtnText & & shet1 & &
Sheets(shet1).Cells(i, k) &
With Sheets(shet1).Cells(i, k).Font
.Bold = True
End With
With Sheets(shet1).Cells(i, k).Interior
.Color = RGB(255, 0, 0)
End With
With Sheets(shet2).Cells(j, k).Font
.Bold = True
End With
With Sheets(shet2).Cells(j, k).Interior
.Color = RGB(255, 0, 0)
End With
Sheets(shet1).Cells(i, k) = diff1
Sheets(shet2).Cells(j, k) = diff2
End If
Next k
End If
End If
Next j
Next i
End Sub