☰

Excel 电子表格 - 分配主表行并删除重复项

tag-icon • tag-icon microsoft-excel microsoft-excel-2010 worksheet-function macros
Excel 电子表格 - 分配主表行并删除重复项

我有一张主表，其中的每一行都分布到具有特定标签的不同表上。

在此处输入图片描述

我想根据 B 列中的信息将每一行分配到适当的选项卡（来自主选项卡）。

我使用代码来分配列，但如果列发生变化，则无法从主数据库中删除/更新列。然后我添加了一个 ID#，该 ID# 对于每个任务都是唯一的。

我尝试将代码更改为从 B 列读取，但最终得到的新工作表编号为 1-31。在我添加 ID# 列并有以下行之前，代码有效：Set rng = ActiveSheet.Range(ActiveSheet.Range("B3"), _read A3。

我的代码：

Sub ProcessRows()

Dim rng As Range, cell As Range
Set rng = ActiveSheet.Range(ActiveSheet.Range("B3"), _
                 ActiveSheet.Cells(Rows.Count, 1).End(xlUp))

For Each cell In rng.Cells
    cell.EntireRow.Copy CopyTo(cell)
Next cell
End Sub

'Return a range object to which a row should be copied
'  Range returned is determined by the value in "rng"
Function CopyTo(rng As Range) As Range

Dim s As Excel.Worksheet, sName As String

sName = Trim(rng.Value) 'just in case...

On Error Resume Next               'ignore any error
Set s = ThisWorkbook.Sheets(sName) 'see if we can grab the sheet
On Error GoTo 0                    'stop ignoring errors

If s Is Nothing Then    'sheet didn't exist: create it
    Set s = ThisWorkbook.Sheets.Add( _
      after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    s.Name = sName
    rng.Parent.Rows(1).Copy s.Range("a1") 'copy headers
End If                  'needed a new sheet
'return the first empty cell in column 1
Set CopyTo = s.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
End Function

我遇到的问题是，如果没有唯一标识符，我不知道如何让宏解读某一行是否已更改并更新它，最终导致出现重复。我们全年都在向此工作簿添加内容，因此让宏更新各个工作表可以节省大量时间。

总而言之，我需要一个宏来：

  1. 将每个主表行分发到每个适当标记的工作表中。
  2. 如果有任何变化，我需要每个唯一的 ID# 来更新该行。
  3. 我还需要确保工作表上没有重复的内容。

如果有一种方法可以让宏在关闭文档时自动运行，那将是一个好处，但我可以接受手动运行宏。

重复的行和信息未更新

答案1

修改此代码

Set rng = ActiveSheet.Range(ActiveSheet.Range("B3"), _
             ActiveSheet.Cells(Rows.Count, 1).End(xlUp))

因为它正在读取第一列，所以是这样的：

Set rng = ActiveSheet.Range(ActiveSheet.Range("B3"), _
             ActiveSheet.Cells(Rows.Count, 2).End(xlUp))

相关内容