Question

我正在尝试执行以下任务。

根据Insert_Data_Sheet表中的行号在DestWorkbook中创建X张新工作表。 我已经解决了这个问题
根据从“ D2”开始的D列数据重命名工作表。因此，我想重命名第一张工作表“ 1865727”和第二张工作表“ 1872188”等。 我已经解决了这个问题
将数据存储在D列中的单独变量中。还没有运气

以下是数据的图片：

https://pasteboard.co/HABwijq.jpg https://pasteboard.co/HABwEhE.jpg

完整代码：

Public Sub TermSwap()

Application.ScreenUpdating = False

Dim DestWorkbook As Workbook, AC_Live_Workbook As Workbook, AC_Maturity_Workbook As Workbook
Dim Insert_Data_Sheet As Worksheet, AC_Live_Sheet As Worksheet, AC_Maturity_Sheet As Worksheet, Booked_Sheet As Worksheet
Dim i As Long, d As Long, lastRowA_AC_Live As Long, lastRow_AC_Maturity As Long, NumberOfPages As Long
'Dim Swap_Link_Tid As Long


'I will use these in the end when importing the AC Reports
'AC_Live_Filename = Application.GetOpenFilename(, , "AVAA AC LIVE RAPORTTI")
'AC_Maturity_Filename = Application.GetOpenFilename(, , "AVAA AC MATURITY RAPORTTI")

'Insert filename from above lines as a parameter in the end
Set DestWorkbook = Workbooks("TermSwap")
Set AC_Live_Workbook = Workbooks.Open(FileName:="C:\Users\z000479\Desktop\Makrot\Term Swap makro\Harjoitustiedostot\ALL_COLUMNS_FI_180817.xlsx")
Set AC_Maturity_Workbook = Workbooks.Open(FileName:="C:\Users\z000479\Desktop\Makrot\Term Swap makro\Harjoitustiedostot\ALL_COLUMNS_FI_180820.xlsx")

Set Insert_Data_Sheet = DestWorkbook.Sheets("Insert_Data")
Set Booked_Sheet = DestWorkbook.Sheets("booked")
Set AC_Live_Sheet = AC_Live_Workbook.Sheets("Result")
Set AC_Maturity_Sheet = AC_Maturity_Workbook.Sheets("Result")

'Finds the last row in A-Column in the AC_Live_Sheet and AC_Maturity_Sheet
lastRow_AC_Live = AC_Live_Sheet.Cells(AC_Live_Sheet.Rows.Count, "A").End(xlUp).Row
lastRow_AC_Maturity = AC_Maturity_Sheet.Cells(AC_Maturity_Sheet.Rows.Count, "A").End(xlUp).Row


'Create X-amount of new sheets in DestWorkbook based on row numbers in the Insert_Data_Sheet table.SOLVED
' Rename the sheet according to the D-Column data starting from "D2". SOLVED
' Store the data in D-column in a seperate variables. UNSOLVED


NumberOfPages = Insert_Data_Sheet.Cells((Insert_Data_Sheet.Rows.Count), "A").End(xlUp).Row - 1



Dim target_range As String

For d = 2 To NumberOfPages + 1

    target_range = Insert_Data_Sheet.Range("D" & d).Value
    DestWorkbook.Worksheets.Add(After:=DestWorkbook.Worksheets(DestWorkbook.Worksheets.Count)).Name = target_range
Next d




' AC LIVE Starts here:

' Show all cells
If AC_Live_Sheet.FilterMode Then
    AC_Live_Sheet.ShowAllData
End If

'Delete row 2
AC_Live_Sheet.Range("2:2").Delete


'Autofiter ON. Filters LIVE_DEAL and SWAP_LINK_TID. Change SWAP_LINK_TID to a variable.
'Range syntax here is Range ("$A$1:$DS$" & lastRow)
If Not AC_Live_Sheet.AutoFilterMode Then
    AC_Live_Sheet.Range("A1").AutoFilter
    AC_Live_Sheet.Range("$A$1:$DS$" & lastRow_AC_Live).AutoFilter Field:=1, Criteria1:= _
        "LIVE_DEAL"
    AC_Live_Sheet.Range("$A$1:$DS$" & lastRow_AC_Live).AutoFilter Field:=7, Criteria1:= _
        "1889087"
End If

'Copy pastes visible cells to Booked_Sheet("A1")
With AC_Live_Sheet
    .UsedRange.SpecialCells(xlCellTypeVisible).Copy Destination:=Booked_Sheet.Cells(1, 1)
End With


' AC_MATURITY starts here


' Show all cells
If AC_Maturity_Sheet.FilterMode Then
    AC_Maturity_Sheet.ShowAllData
End If

'Delete row 2
AC_Maturity_Sheet.Range("2:2").Delete


'Autofiter ON. Filters LIVE_DEAL and SWAP_LINK_TID.
'Range syntax here is Range ("$A$1:$DS$" & lastRow)
'I need to change SWAP_LINK_TID to a variable
If Not AC_Maturity_Sheet.AutoFilterMode Then
    AC_Maturity_Sheet.Range("A1").AutoFilter
    AC_Maturity_Sheet.Range("$A$1:$DS$" & lastRow_AC_Maturity).AutoFilter Field:=1, Criteria1:= _
        "LIVE_DEAL", Operator:=xlOr, Criteria2:="=MAT_DEAL"
    AC_Maturity_Sheet.Range("$A$1:$DS$" & lastRow_AC_Maturity).AutoFilter Field:=7, Criteria1:= _
        "1889087"

End If

'Copy pastes visible cells to Booked_Sheet("A1")
With AC_Maturity_Sheet
    .UsedRange.SpecialCells(xlCellTypeVisible).Copy Destination:=Booked_Sheet.Cells(6, 1)
End With


'Closes AC Workbooks and activates the Booked_Sheet
' Error here. It asked the file to be saved. I want to ignore it.
AC_Live_Workbook.Close
AC_Maturity_Workbook.Close
Booked_Sheet.Activate


Application.ScreenUpdating = True


End Sub

Answer 1

以下内容显示了如何将唯一的D列数字作为关键字加载到字典中，并循环该字典的关键字以添加新的工作表。您可以在同一循环中进行过滤，再次使用字典的当前键进行过滤或稍后使用。这并不是要复制粘贴的工作，而是向您展示可以使用的部件。

Option Explicit
Public Sub test()
   Dim valuesDict As Object, arr(), i As Long, lastRow As Long
   Set valuesDict = CreateObject("Scripting.Dictionary")

   With ThisWorkbook.Worksheets("Sheet1")
      lastRow = .Cells(.Rows.Count, "D").End(xlUp).Row  'find last row of your numbers

      Select Case lastRow
      Case Is < 2
          Exit Sub
      Case 2   '< Load your number into an array
          ReDim arr(1, 1)
          arr(1, 1) = .Range("D2")
      Case Else
          arr = .Range("D2:D" & lastRow).Value
      End Select
   End With
   For i = LBound(arr, 1) To UBound(arr, 1) 'Add unique values to the range
       valuesDict(arr(i, 1)) = 1
   Next

   Dim key As Variant
   For Each key In valuesDict.keys
       If Not Evaluate("ISREF('" & key & "'!A1)") Then  'If sheet doesn't exist add it. Credit to @Rory for this method.
           ThisWorkbook.Worksheets.Add
           ActiveSheet.NAME = key
       End If
   Next key
   'Other code.......
   For Each key In valuesDict.keys
       AC_Live_Sheet.Range("$A$1:$DS$" & lastRow_AC_Live).AutoFilter Field:=7, Criteria1:=key
   Next key
   'Other code
End Sub

VBA在for循环中基于变量重命名工作表并存储新变量

1 个答案: