Question

我是VBA的新手，并且将下面的代码组合在一起，但是似乎我所做的事情过于多余。我已经将我的VBA代码分解为4个步骤，但是我确信有一种更快的方法。基本上，我有需要下载的银行报告，并且仅从中提取了相关信息。在我的代码中，此银行报告包含在“详细信息”表中。该报告是可变的，具体取决于日期和发生的交易。此报告中的所有信息均基于J列中的BAI银行代码。在我的流程中，第1步是获取当天所有BAI代码的唯一列表，并将该信息粘贴到新的名为“当前白名单”的表格。 第2步我创建了多个以第1步中唯一的BAI代码命名的工作表。第3步是删除不相关的工作表。例如，某些BAI代码是我不感兴趣且无法使用的摘要交易。 第4步是从“详细”主表单中获取所有与相关的行，这些信息与剩余的有用BAI代码匹配，然后将该信息粘贴到相应的表单上。我需要以下方面的帮助-理想情况下，在第3步中，我希望不要列出需要保留以将列表存储在一定范围内的所有工作表，而只需插入列表名称即可。在第4步中，我陷入了Set Target = ActiveWorkbook.Worksheets(d.Value)的困境。如我所说，这似乎是非常冗长而乏味的代码。任何和所有帮助表示赞赏。

    Sheets.Add(After:=Sheets(Sheets.Count)).Name = "CURRENT BAI LIST"

    Worksheets("DETAIL").Activate
    Sheets("DETAIL").Range("J6:J1000").Select
    Selection.Copy
    Sheets("CURRENT BAI LIST").Select
    Sheets("CURRENT BAI LIST").Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveSheet.Range("$A$1:$A$1000").RemoveDuplicates Columns:=1, Header:=xlYes
    Sheets("CURRENT BAI LIST").Range("A1").Select
    Sheets("CURRENT BAI LIST").Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.DELETE
    '---END OF ADDS NEW SHEET FOR CURRENT BAI LIST AND COPIES THE DATA FROM "DETAIL" SHEET TO NEW SHEET


    'CREATES MULTIPLE SHEETS BASED ON THE UNIQUE BAI TRANSACTIONS
    Dim xRg As Excel.Range
    Dim wsH As Excel.Worksheet
    Dim wBk As Excel.Workbook
    Set wsH = ActiveWorkbook.Worksheets("CURRENT BAI LIST")
    Set wBk = ActiveWorkbook
    Dim L As Range
    Set L = Worksheets("CURRENT BAI LIST").UsedRange

    For Each xRg In L
        With wBk
            .Sheets.Add After:=.Sheets(.Sheets.Count)
            On Error Resume Next
            ActiveSheet.Name = xRg.Value
            If Err.Number = 1004 Then
              Debug.Print xRg.Value & " already used as a sheet name"
            End If
            On Error GoTo 0
        End With
    Next xRg
    '----END OF CREATES MULTIPLE SHEETS BASED ON THE UNIQUE BAI TRANSACTIONS


   'DELETES ALL NON-NECESSARY SHEETS SUCH AS SUMMARY BAI SHEETS AND OTHER
    Application.DisplayAlerts = False
    For Each wsH In Worksheets
        Select Case wsH.Name
            'Include sheet names to keep on next line (with comma between)
            Case "CASH SHEET", "BAI CODES", "DETAIL", "CURRENT BAI LIST", "164", "165", "187", "191", "195", "201", "255", "301", "354", "357", "455", "475", "491", "495", "501", "508", "555", "661", "856", "868"
                'Do nothing
            Case Else
                wsH.DELETE
        End Select
    Next wsH

    Application.DisplayAlerts = True
    '---END OF DELETES ALL NON-NECESSARY SHEETS SUCH AS SUMMARY BAI SHEETS AND OTHER

    'COPIES DATA FROM "DETAILS" SHEET TO ITS RESPECTIVE UNIQUE SHEET
    Dim c As Range
    Dim j As Integer
    Dim Source As Worksheet
    Dim Target As Worksheet
    Dim Condition As Worksheet


    Set Source = ActiveWorkbook.Worksheets("DETAIL")
    Set Condition = ActiveWorkbook.Worksheets("CURRENT BAI LIST")

    j = 2    'This will start copying data to Target sheet at row 2
      For Each d In L 'Condition.Range("A1:A86")
      Set Target = ActiveWorkbook.Worksheets(d.Value)
        For Each c In Source.Range("J1:J1000")
            If d = c Then
            Set Target = ActiveWorkbook.Worksheets(d.Value)
                Source.Rows(c.Row).Copy Target.Rows(j)
                j = j + 1
            End If
        Next c
      Next d
   '----END OF COPIES DATA FROM "DETAILS" SHEET TO ITS RESPECTIVE UNIQUE SHEET

根据条件将行从一张工作表复制到另一张工作表，同时创建唯一的工作表名称

0 个答案: