Question

我有这个问题，我正在努力解决。每天我都会收到一份报告，其中包含我需要发送的数据。所以为了使它更容易一点，我试图找到一个宏来创建一个带有代理名称的新工作表，并为创建的工作表中的每个代理移动数据......

我找到了一个可以做到这一点的人。但由于这不是我的专业领域，我无法修改它以处理我的请求，甚至可能使其工作。任何人都有任何想法？

Const cl& = 2
Const datz& = 1

Dim a As Variant, x As Worksheet, sh As Worksheet
Dim rws&, cls&, p&, i&, ri&, j&
Dim u(), b As Boolean, y

Application.ScreenUpdating = False
Sheets("Sheet1").Activate
rws = Cells.Find("*", , , , xlByRows, xlPrevious).Row
cls = Cells.Find("*", , , , xlByColumns, xlPrevious).Column

Set x = Sheets.Add(After:=Sheets("Sheet1"))
Sheets("Sheet1").Cells(1).Resize(rws, cls).Copy x.Cells(1)
Set a = x.Cells(1).Resize(rws, cls)
a.Sort a(1, cl), 2, Header:=xlYes
a = a.Resize(rws + 1)
p = 2

For i = p To rws + 1
    If a(i, cl) <> a(p, cl) Then
        b = False
        For Each sh In Worksheets
            If sh.Name = a(p, cl) Then b = True: Exit For
        Next
        If Not b Then
            Sheets.Add.Name = a(p, cl)
            With Sheets(a(p, cl))
                x.Cells(1).Resize(, cls).Copy .Cells(1)
                ri = i - p
                x.Cells(p, 1).Resize(ri, cls).Cut .Cells(2, 1)
                .Cells(2, 1).Resize(ri, cls).Sort .Cells(2, datz), Header:=xlNo
                y = .Cells(datz).Resize(ri + 1)
                ReDim u(1 To 2 * ri, 1 To 1)
                For j = 2 To ri
                    u(j, 1) = j
                    If y(j, 1) <> y(j + 1, 1) Then u(j + ri, 1) = j
                Next j
                .Cells(cls + 1).Resize(2 * ri) = u
                .Cells(1).Resize(2 * ri, cls + 1).Sort .Cells(cls + 1), Header:=xlYes
                .Cells(cls + 1).Resize(2 * ri).ClearContents
            End With
        End If
        p = i
    End If
Next i


Application.DisplayAlerts = False
    x.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True

这是我收到的报告的一个例子 example

我一直在行上出错：a.Sort a（1，cl），2，Header：= xlYes 在我自己，我真的不知道它做了什么。谁能解释一下？

Answer 1

这是一个通用模型（评论很多），应该生成您的个人代理工作表。这将复制原始的“主”工作表，并删除与每个代理无关的信息。

<强> Module1 code

if( one of the materials is wood && one of the materials is metal )
{
    //play sound for metal-wood collision
}

有时候删除你不想要的东西比重新创建你开始时的许多部分更容易。

Answer 2

有了@Jeeped的好答案，我还会补充第二个答案。： - ）

要将每个代理商数据分隔为单独的工作表，您可以执行以下操作... 看到代码评论

Option Explicit
Sub Move_Each_Agent_to_Sheet()
'   // Declare your Variables
    Dim Sht As Worksheet
    Dim Rng As Range
    Dim List As Collection
    Dim varValue As Variant
    Dim i As Long

'   // Set your Sheet name
    Set Sht = ActiveWorkbook.Sheets("Sheet1")

'   // set your auto-filter,  A6
    With Sht.Range("A6")
        .AutoFilter
    End With

'   // Set your agent Column range # (2) that you want to filter it
    Set Rng = Range(Sht.AutoFilter.Range.Columns(2).Address)

'   // Create a new Collection Object
    Set List = New Collection

'   // Fill Collection with Unique Values
    On Error Resume Next
    For i = 2 To Rng.Rows.Count
        List.Add Rng.Cells(i, 1), CStr(Rng.Cells(i, 1))
    Next i

'   // Start looping in through the collection Values
    For Each varValue In List
'       // Filter the Autofilter to macth the current Value
        Rng.AutoFilter Field:=2, Criteria1:=varValue

'       // Copy the AutoFiltered Range to new Workbook
        Sht.AutoFilter.Range.Copy
        Worksheets.Add.Paste
        ActiveSheet.Name = Left(varValue, 30)
        Cells.EntireColumn.AutoFit

'   // Loop back to get the next collection Value
    Next varValue

'   // Go back to main Sheet and removed filters
    Sht.AutoFilter.ShowAllData
    Sht.Activate
End Sub

为每个唯一代理创建一个新工作表，并将所有数据移动到每个工作表

2 个答案: