Question

是否存在可以根据该行中的特定值将数据行传输到其他工作表的宏。例如，我在中央工作表中有以下数据：Masterlog.xls：

（连字符表示一列）

苹果 - 12312312

Green Apples - 32132132

芒果 - 00000000

Green Mangoes - 11111111

香蕉 - 22222222

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

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

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

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

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

宏应始终在最后一个带有内容的第一个空行上写入。

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

Answer 1

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

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

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

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

中央工作表，根据特定条件将内容分发到其他工作表

1 个答案: