显示excel状态栏中两个单元格之间的差异

我正在寻找代码来确定两个选定单元格之间的差异，并将其显示在Excel 2010的状态栏中。

我发现了一些代码，但它只适用于包含该代码的工作簿。 是否有可能使这个代码在我正在使用的每个工作簿上都可用？ 如果这种types的代码像personal.xlsb中的macros一样自动运行，那就太好了。

Public Sub workbook_SheetSelectionChange(ByVal sh As Object, ByVal Target As Range) Set sh = ActiveSheet If Selection.Cells.Count = 2 Then On Error Resume Next If WorksheetFunction.Count(Range(Selection.Address)) = 2 Then Application.StatusBar = "The difference is " & _ WorksheetFunction.Max(Range(Selection.Address)) _ - WorksheetFunction.Min(Range(Selection.Address)) Else Application.StatusBar = "The difference is " & _ WorksheetFunction.Max(Range(Selection.Address)) End If Else Application.StatusBar = False End If End Sub 

Answer 1

我发现了一些代码，但它只适用于包含该代码的工作簿。 是否有可能使这个代码在我正在使用的每个工作簿上都可用？

您将不得不为此创build一个加载项。 然后将其放置在您的Add-In的ThisWorkbook模块中。 加载项创build完成后，通过选中“开发人员”选项卡上的“加载项”部分的checkbox将其激活。

 Private WithEvents oXLApp As Excel.Application Private Sub Workbook_Open() Set oXLApp = Excel.Application End Sub Private Sub oXLApp_SheetSelectionChange(ByVal Sh As Object, _ ByVal Target As Range) ' '~~> Rest of the code here ' End Sub 

Answer 2

这些问题产生了以下工具。

将以下项目另存为.xla

的ThisWorkbook：

 Private WithEvents oXLApp As Excel.Application Private Sub Workbook_Open() Set oXLApp = Excel.Application End Sub Private Sub oXLApp_SheetSelectionChange(ByVal Sh As Object, ByVal Target As range) Dim limit As Long limit = 300000 ' selection limit Dim frmt As String frmt = "#,##0;(#,##0);""-""" ' formating at status bar ' first condition - one selection area If Selection.Areas.Count = 1 Then On Error Resume Next If Selection.Cells.Count > 1 And Selection.Cells.Count < limit Then On Error Resume Next Application.StatusBar = _ " D: " & Format(WorksheetFunction.Max(Selection) - WorksheetFunction.Min(Selection), frmt) & _ " U: " & Format(Unique(Selection), frmt) & _ " 2X: " & Format(WorksheetFunction.Sum(Selection) * 2, frmt) & _ " X2: " & Format(WorksheetFunction.Sum(Selection) / 2, frmt) & _ " NC: " & Format(WorksheetFunction.CountIf(Selection, "<0"), frmt) & _ " NS: " & Format(WorksheetFunction.SumIf(Selection, "<0"), frmt) Else If Selection.Cells.Count = 1 Or Selection.Cells.Count >= limit Then On Error Resume Next Application.StatusBar = False End If ' No condition End If ' Cells > 2 and < limit End If ' Areas = 1 - end of first condition ' second condition - more than one selection areas If Selection.Areas.Count > 1 Then Dim r1 As range Dim r2 As range Set r1 = Selection.Areas(1) 'WorksheetFunction.Sum (r1) On Error Resume Next Set r2 = Selection.Areas(2) 'Set multipleRange = Union(r1, r2) On Error Resume Next If Selection.Cells.Count > 1 And Selection.Cells.Count < limit Then On Error Resume Next Application.StatusBar = _ " D: " & Format(DIFF(r1, r2), frmt) & _ " U: " & Format(Unique(r1), frmt) & _ " 2X: " & Format(WorksheetFunction.Sum(r1) * 2, frmt) & _ " X2: " & Format(WorksheetFunction.Sum(r1) / 2, frmt) & _ " NC: " & Format(WorksheetFunction.CountIf(r1, "<0"), frmt) & _ " NS: " & Format(WorksheetFunction.SumIf(r1, "<0"), frmt) Else If Selection.Cells.Count = 1 Or Selection.Cells.Count >= limit Then On Error Resume Next Application.StatusBar = False End If ' no condition End If ' Cells > 1 End If ' Areas > 1 - end of second condition End Sub 

模块1：

 Public Function DIFF(rng1 As range, rng2 As range) DIFF = WorksheetFunction.Sum(rng1) - WorksheetFunction.Sum(rng2) End Function 

模块2：

 Public Function Unique(ByRef rngToCheck As range) As Variant Dim colDistinct As Collection Dim varValues As Variant, varValue As Variant Dim lngCount As Long, lngRow As Long, lngCol As Long On Error GoTo ErrorHandler varValues = rngToCheck.Value 'if rngToCheck is more than 1 cell then 'varValues will be a 2 dimensional array If IsArray(varValues) Then Set colDistinct = New Collection For lngRow = LBound(varValues, 1) To UBound(varValues, 1) For lngCol = LBound(varValues, 2) To UBound(varValues, 2) varValue = varValues(lngRow, lngCol) 'ignore blank cells and throw error 'if cell contains an error value If LenB(varValue) > 0 Then 'if the item already exists then an error will 'be thrown which we want to ignore On Error Resume Next colDistinct.Add vbNullString, CStr(varValue) On Error GoTo ErrorHandler End If Next lngCol Next lngRow lngCount = colDistinct.Count Else If LenB(varValues) > 0 Then lngCount = 1 End If End If Unique = lngCount Exit Function ErrorHandler: Unique = CVErr(xlErrValue) End Function