Excel 基于特定标准将内容分发到其他工作表的中心工作表

是否有一个宏可以将数据行传输到不同的工作表，具体取决于该行的某个值。例如，我在中心工作表Masterlog.xls中有以下数据：

（连字符表示一列）

苹果-12312

青苹果-32132

芒果-00000000

绿芒果-11111

香蕉-2222

masterlog数据每天由2人手动更新。有时数据是昨天的重复数据，我也希望有一个宏可以忽略重复数据并记住2天前的数据，但清除较旧的数据

列A的值将决定数据行将转到哪个工作表

苹果-12312应转移到工作表Apples.xls中

Green Apples-32132也会转移到下一行的Apples.xls。

芒果-00000000转到Mangoes.xls，依此类推

宏应始终在最后一个包含内容的空行之后的第一个空行上写入。

---

Apples.xls、Mangoes.xls和Bananas.xls是22个用户共享的工作表。

此代码可以将数据复制到相应的工作表中。它不会事先清除工作表，这意味着如果您多次运行宏，它会在已经存在的条目之后添加相同的条目，但应该给您一个开始的空间

Option Explicit
Sub test()

Dim col As New Collection, cell As Range, ChkRng As Range, entry As Variant, lstRw As Long, i As Long

With Sheets("Masterlog")
    Set ChkRng = .Range("A4:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
End With

On Error Resume Next

For Each cell In ChkRng
    If col.Count = 0 Then GoTo Add
        For i = 1 To col.Count
            If cell.Value Like "*" & col.Item(i) Then
                GoTo continue
            End If
        Next i
Add:
            col.Add cell.Value, cell.Value



continue:

Next cell
On Error GoTo 0

For Each cell In ChkRng
    For i = 1 To col.Count



            If cell.Value = col.Item(i) Then
                If WorksheetExists(col.Item(i)) = False Then
                    Worksheets.Add , Sheets("Masterlog")
                    ActiveSheet.Name = col.Item(i)
                    With Sheets(col.Item(i))
                        lstRw = .Range("A" & .Rows.Count).End(xlUp).Row
                        .Range("A" & lstRw) = cell.Value
                        .Range("A" & lstRw).Offset(0, 1) = cell.Offset(0, 1).Value
                    End With
                Else
                    With Sheets(col.Item(i))
                        lstRw = .Range("A" & .Rows.Count).End(xlUp).Row + 1
                        .Range("A" & lstRw) = cell.Value
                        .Range("A" & lstRw).Offset(0, 1) = cell.Offset(0, 1).Value
                    End With
                End If
                GoTo onwards
            ElseIf cell.Value Like "*" & col.Item(i) = True Then
                If WorksheetExists(col.Item(i)) = False Then
                        Worksheets.Add , Sheets("Masterlog")
                        ActiveSheet.Name = col.Item(i)
                    With Sheets(col.Item(i))
                        lstRw = .Range("A" & .Rows.Count).End(xlUp).Row
                        .Range("A" & lstRw) = cell.Value
                        .Range("A" & lstRw).Offset(0, 1) = cell.Offset(0, 1).Value
                    End With
                Else
                    With Sheets(col.Item(i))
                        lstRw = .Range("A" & .Rows.Count).End(xlUp).Row + 1
                        .Range("A" & lstRw) = cell.Value
                        .Range("A" & lstRw).Offset(0, 1) = cell.Offset(0, 1).Value
                    End With
                End If
                GoTo onwards
            End If


    Next i
onwards:
Next cell

End Sub

Public Function WorksheetExists(ByVal WorksheetName As String) As Boolean

On Error Resume Next
WorksheetExists = (Sheets(WorksheetName).Name <> "")
On Error GoTo 0

End Function

选项显式
子测试（）
Dim col作为新集合，cell作为范围，ChkRng作为范围，entry作为变量，lstRw作为长，i作为长
带图纸（“Masterlog”）
设置ChkRng=.Range（“A4:A”和.Range（“A”和.Rows.Count）.End（xlUp.Row）
以
出错时继续下一步
对于ChkRng中的每个单元格
如果列计数=0，则转到添加
对于i=1到列计数
如果单元格值如“*”和列项（i），则
继续
如果结束
接下来我
加：
列。添加单元格。值，单元格。值
继续：
下一个细胞
错误转到0
对于ChkRng中的每个单元格
对于i=1到列计数
如果cell.Value=col.Item（i），则
如果工作表列表（列项目（i））=False，则
工作表。添加，工作表（“主日志”）
ActiveSheet.Name=col.Item（i）
附页（列项目（i））
lstRw=.Range（“A”&.Rows.Count）.End（xlUp）.Row
.Range（“A”&lstRw）=单元格值
.Range（“A”&lstRw）.Offset（0,1）=单元格偏移量（0,1）.Value
以
其他的
附页（列项目（i））
lstRw=.Range（“A”&.Rows.Count）.End（xlUp）.Row+1
.Range（“A”&lstRw）=单元格值
.Range（“A”&lstRw）.Offset（0,1）=单元格偏移量（0,1）.Value
以
如果结束
转到前面
ElseIf cell.Value，如“*”和col.Item（i）=则为True
如果工作表列表（列项目（i））=False，则
工作表。添加，工作表（“主日志”）
ActiveSheet.Name=col.Item（i）
附页（列项目（i））
lstRw=.Range（“A”&.Rows.Count）.End（xlUp）.Row
.Range（“A”&lstRw）=单元格值
.Range（“A”&lstRw）.Offset（0,1）=单元格偏移量（0,1）.Value
以
其他的
附页（列项目（i））
lstRw=.Range（“A”&.Rows.Count）.End（xlUp）.Row+1
.Range（“A”&lstRw）=单元格值
.Range（“A”&lstRw）.Offset（0,1）=单元格偏移量（0,1）.Value
以
如果结束
转到前面
如果结束
接下来我
向前：
下一个细胞
端接头
作为布尔值的公共函数工作表列表（ByVal工作表名称为字符串）
出错时继续下一步
工作表列表=（工作表（工作表名称）.Name“”）
错误转到0
端函数

目前，它同时传输A列中的值和B列中的值，但您应该根据自己的需要进行更改

---

它适用于你的例子。我不知道更复杂的模式。

Hi@Alex4336，不，我还没有尝试过任何东西。我不知道如何从头开始写代码…请有人帮助。。。非常感谢。嗨，谢谢你。这是我可以处理的事情。如果不使用不同的工作表，而是使用不同的工作簿呢？这是一个很大的代码变化吗？非常感谢@alex4336这很有效！只需一些编辑，我想这将是完美的！谢谢你！不过我还有一个后续问题，如果不是不同的工作表，而是不同的工作手册呢？这是一个很大的代码变化吗？非常感谢@Alex4336，当然可以为不同的工作簿制作，但我认为需要打开特定的工作簿（如果存在），或者在您选择的文件夹中创建一个。