1

我在 excel 中有一个共享工作簿,其中包含几张工作表和一个名为概述的主工作表。

例如概览 - Sheet1 - Sheet2 - Sheet 3

在工作表 1/2/3 中,我或其他人用一些数据更新行。

很难跟踪工作簿中的最后一个条目(因为我需要在所有工作表中搜索),所以我想在我的概览页面中创建一个“前 10 名”动态列表,该列表将自动更新最后一个工作簿中的 10 个更新行。

有人可以帮我吗?

这是一个例子:在此处输入图像描述

谢谢!

4

1 回答 1

4

最干净的解决方案是:

在工作簿级别添加事件处理程序以捕获正在更改的单元格;在处理程序中,执行以下操作:

  • 关闭事件处理(您将更改工作表并且不想进入无限循环)!
  • 关闭屏幕更新
  • 在前页的第 1 行中插入一行
  • 在此处输入已更改行的副本
  • 在附加列中添加更改它的用户和日期/时间(如果您愿意)
  • 回到原来的选择
  • 开启屏幕更新
  • 开启事件处理

以下是分步说明(示例文件可从http://www.floris.us/SO/download/XLexample.xlsm下载) - 假设 PC 上使用 Excel 2010。其他版本的差异大多很小......

  1. 确保您的文件保存为.xlsm格式 - 这告诉 Excel 有宏
  2. 在添加所有这些东西之前创建文件的备份 - 以防你搞砸了!
  3. 关闭所有其他文件(暂时) - 请参阅前面的评论
  4. 确保你的文件有四个工作表:“summary”、“widgets”、“things”和“stuff”(或任何你认为有帮助的名称——我会用这些名称来引用它们,而不是“Sheet1”等)
  5. 右键单击“小部件”选项卡,然后选择“查看代码”
  6. 将以下代码粘贴到工作表的“代码”窗口中:

.

Private Sub Worksheet_Change(ByBal Target as Range)
  On Error GoTo procErr
  process_change Target
  Exit Sub

procErr:
  MsgBox "Got an error: " & Err.Description
  Err.Clear
  Application.EnableEvents = True
End Sub`
  1. 对每个“数据”工作表重复上述步骤:“事物”和“东西”(但不适用于“摘要”)
  2. 当 Visual Basic 编辑器打开时(这是您进行所有粘贴的地方),使用 Insert->Module 在工作簿中插入一个新代码模块
  3. 将以下代码粘贴到您创建的模块中:

.

Option Explicit

Sub process_change(ByVal Target As Range)
' when a cell is changed on one of the worksheets, this function is called
' it copies the most recently changed row
' and inserts it on the second line of the "summary" worksheet
' right below the headers
' if the headers include "changed by" and/or "last changed" (exactly)
' then that column will be updated with the (windows) user name and date, respectively
' similarly, if a column named "source" exists, it will contain the address of the row
' (sheet name / row number). In that case, if there was an earlier occurrence of the same row
' (multiple edits), the earlier occurence is removed
' you may use this code as is - but there is no warranty as to its useability

Dim s1 As Worksheet, s2 As Worksheet
Dim srcAddress As String
Dim oldSelection As Range

' don't update screen during processing - prevent "flickering"
Application.ScreenUpdating = False ' set to True when debugging

' don't accept events until we're done
Application.EnableEvents = False

' store old selection
Set oldSelection = Selection

Dim ri As Integer           ' index of changed row
Dim rowAddress As String
ri = Target.Row
rowAddress = ri & ":" & ri  ' address of changed row

if ri = 1 Then
  Application.EnableEvents = True
  Exit Sub                  ' don't record changes to the headers
End If

Range(rowAddress).Select
Selection.Copy              ' copy changed row

Set s1 = ActiveSheet        ' know where we will go back to
srcAddress = s1.Name & ":row" & ri ' full address to be used later

Set s2 = ActiveWorkbook.Sheets("summary")

s2.Range("2:2").Insert      ' add a row at the top of the list
s2.Select                   ' activate sheet where we want to paste
Range("A2").Select          ' leftmost cell of column
ActiveSheet.Paste           ' paste the entire changed row

' optionally, we can add "source", "last changed" and "changed by"
' we do this if appropriately named columns exist
' slightly clumsy code to catch errors...
Dim lcCol
If Not IsError(Application.Match("last changed", Range("1:1"), 0)) Then
  lcCol = Application.Match("last changed", Range("1:1"), 0)
  Range("A2").Offset(0, lcCol - 1).Value = Date
End If

Dim cbCol
If Not IsError(Application.Match("changed by", Range("1:1"), 0)) Then
  cbCol = Application.Match("changed by", Range("1:1"), 0)
  Range("A2").Offset(0, cbCol - 1).Value = UserName
End If

Dim srcCol
If Not IsError(Application.Match("source", Range("1:1"), 0)) Then
  srcCol = Application.Match("source", Range("1:1"), 0)
  ' find earlier entry regarding this row...
  Columns("A:A").Offset(0, srcCol - 1).Select
  Dim sf As Range
  Set sf = Selection.Find(What:=srcAddress, After:=ActiveCell, LookIn:= _
        xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:= _
        xlNext, MatchCase:=False, SearchFormat:=False)
  If Not sf Is Nothing Then
  ri = sf.Row
  rowAddress = ri & ":" & ri  ' address of changed row
  Range(rowAddress).Select
  Selection.Delete
  End If
  Range("A2").Offset(0, srcCol - 1).Value = srcAddress
End If

s1.Activate                     ' go back to original worksheet
Application.CutCopyMode = False ' get rid of the "marching ants"
oldSelection.Select             ' select the previous selection "like nothing happened"

' and turn on screenupdating and events...
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

Sub eventsOn()
Application.EnableEvents = True
End Sub

Public Function UserName()
' note - this function only works on PC
  UserName = Environ$("UserName")
End Function

完成所有这些后,您现在可以在工作表中放置标题 - 在所有四张工作表中使用相同的列标题。在第一个(摘要)表中,您可以选择添加另外三个标题:这些标题不应与您使用的其他标题相同,并且被称为(完全正确 - 没有额外的空格,大写,...):, source, .last changedchanged by

如果最后三个列标题不存在,则行为如下:

每次对三个工作表中的一个进行更改时,所做更改的行将被复制到摘要表的第一行,标题下方。其他所有内容都会向下移动一排。

如果添加“源”列,将发生两件事:源(工作表名称:行号)将添加到该列中,并且将删除同一源(同一行)的任何先前条目。因此,您只会看到给定行的“最新更改”。

如果添加“更改者”,您将获得最后更改的用户的名称;“上次更改”标题将包含上次更改的日期。

让我知道您是否可以从这里弄清楚 - 如果您遇到困难,请使用我上面链接的示例电子表格来指导您。

于 2013-02-02T03:06:31.713 回答