Question

我正在实习，并在VBA获得了一项任务，我对此知之甚少。我找到了与我需要的功能类似的代码，并用我最好的猜测对其进行了评论。如果您能帮助我了解每件作品的作用以及在哪里用我自己的信息替换通用代码，我们将不胜感激！

当顾客有过期记录时，会向他们发送一个电子表格，其中包含他们必须返回的记录列表以及以下列中的记录属性。

我需要创建一个

的宏

创建新工作簿
复制第1行（标题）
复制具有相同用户的行
将文件命名为“UniqueUserrecordsrecall.xlsx”
保存到C：\ Users \ xxx \ Documents \ xxx \ xxx

属性：记录，描述，客户，参与度，天数，日期，类型，LOS，位置，状态，最终用户。

工作簿名称：RecordsRecall

工作表名称：主要

Sub details()

'Declaration
Dim thisWB  As String
Dim newWB As String

thisWB = ActiveWorkbook.Name

'?
On Error Resume Next
Sheets("tempsheet").Delete
On Error GoTo 0

'CreateTempSheet    
Sheets.Add
ActiveSheet.Name = "tempsheet"

'?    
Sheets("Main").Select

If ActiveSheet.AutoFilterMode Then
    Cells.Select

    On Error Resume Next
    ActiveSheet.ShowAllData
    On Error GoTo 0

End If

'Copy User Column    
Columns("L:L").Select
Selection.Copy

'Paste User Column in TempSheet    
Sheets("tempsheet").Select
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False

'?    
If (Cells(1, 1) = "") Then
    LastRow = Cells(1, 1).End(xlDown).Row

    If LastRow <> Rows.Count Then
        Range("A1:A" & LastRow - 1).Select
        Selection.Delete Shift:=xlUp
    End If

End If

'Apply Unique Filters in Tempsheet    
Columns("A:A").Select
Columns("A:A").AdvancedFilter Action:=xlFilterCopy, _
            CopyToRange:=Range("B1"), Unique:=True

'?     
Columns("A:A").Delete

Cells.Select
Selection.Sort _
        Key1:=Range("A2"), Order1:=xlAscending, _
        Header:=xlYes, OrderCustom:=1, _
        MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal

lMaxSupp = Cells(Rows.Count, 1).End(xlUp).Row

For suppno = 2 To lMaxSupp

    Windows(thisWB).Activate

    supName = Sheets("tempsheet").Range("A" & suppno)

    If supName <> "" Then

        Workbooks.Add
        ActiveWorkbook.SaveAs supName
        newWB = ActiveWorkbook.Name

        Windows(thisWB).Activate

        Sheets("Main").Select
        Cells.Select

        If ActiveSheet.AutoFilterMode = False Then
            Selection.AutoFilter
        End If

        Selection.AutoFilter Field:=2, Criteria1:="=" & supName, _
                    Operator:=xlAnd, Criteria2:="<>"

        LastRow = Cells(Rows.Count, 2).End(xlUp).Row

        'Copy from TempSheet
        Rows("1:" & LastRow).Copy

        'Paste in newWB in TempSheet
        Windows(newWB).Activate
        ActiveSheet.Paste

        'Save and Close newWB
        ActiveWorkbook.Save
        ActiveWorkbook.Close

    End If

Next

'Delete TempSheet
Sheets("tempsheet").Delete

Sheets("Main").Select
If ActiveSheet.AutoFilterMode Then
    Cells.Select
    ActiveSheet.ShowAllData
End If

End Sub

感谢您的帮助！

Answer 1

我猜这段代码没有达到你所寻求的效果，你不知道从哪里开始修复它。

当你真的不知道自己在做什么时，你一次又一次地尝试着。

我建议你从编写简单的宏开始，每个宏都可以实现总需求的一个步骤，或者向前一个宏添加一步。如果您遇到其中一个宏的困难，可以发布它，并解释它的作用以及您希望它做什么。使用隔离单个问题的宏的问题可以很快得到解答。我不知道从哪里开始调试你当前的宏。

你有一个自动过滤器，但我看不出如何选择具有过期记录的顾客的记录。我认为这是你的第一个问题：宏如何知道哪个顾客的记录要输出？这可能是supName吗？这来自哪里？

您是否可以编写一个创建空工作簿并使用所需名称保存的宏？称之为Macro1。

通过更新Macro1来编写Macro2，将Sheet1重命名为“Overdue”或更有意义的内容，然后删除其他工作表。

你能编写一个使用AutoFilter来选择所需记录的宏吗？将其写为新宏Macro3。

合并Macro2和Macro3，然后尝试将AutoFilter选择的行复制到新工作簿。声明SourceRange.Copy Destination:=FirstDestCell可能比Copy and Paste更容易使用。

我希望您能看到为什么一次一步扩展您的知识的小宏将比您尝试调试当前代码更容易实现目标。

创建新的Excel工作簿并复制具有某些特征的信息

1 个答案: