Question

我有一个由2个循环组成的宏，但我只是寻找第二个循环的帮助（将其命名为注释为＆＃34;交易名称为循环＆＃34;供您参考）。第二个循环的作用是它遍历我的工作表，收集每个工作表中单元格A1中的值，然后将该值放在第4行的下一个（右边）空单元格中，在另一个工作表中，其名称对应于什么是在单元格I3中，它循环通过。我包括我的代码因为我理解它有点令人困惑。

我想要做的第二个循环是不允许第4行中的重复值。基本上，宏将运行多次，我不希望它将所有值从单元格A1编译成每次排第4行。现在我一直试图找到一种方法来删除第4行中的重复值（如我的代码末尾所示），但我意识到这不是处理问题的有效方法。我宁愿For循环跳过复制单元格A1的过程，如果它到达了单元格A1已经在第4行的工作表，在另一个工作表中。

Sub AggLoop()
    Dim ws As Worksheet
    Dim rng As Range
    Dim nme As String
    Dim Crng As Range
    Dim HdrCol As Range
    Dim Site As String
    Dim SearchRange As Range
    Dim HdrRow As Range
    Dim FinDate As Date


Application.ScreenUpdating = False

 ' Date For Loop
    For Each ws In ActiveWorkbook.Worksheets
    nme = ws.Range("I3").Text
    Set rng = ws.Range("T7:T200")

    'Dont Copy Data from these worksheets
    If ws.Name <> "Portfolio" And ws.Name <> "Master" And ws.Name <> "Template" And ws.Name <> "Coal" And ws.Name <> "E&P" And ws.Name <> "Gas Gen" And ws.Name <> "Hydro" And ws.Name <> "LNG" And ws.Name <> "Midstream" And ws.Name <> "Solar" And ws.Name <> "Transmission" And ws.Name <> "Wind" Then
    'Storing Copied data into cell (A5)
       If IsEmpty(Sheets(nme).[A1]) Then
       rng.Copy Sheets(nme).Range("A" & Rows.Count).End(xlUp)

    'Storing next copied data below previously filled cell
      Else
          rng.Copy Sheets(nme).Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
      'Delete duplicates
          Sheets(nme).Range("A4:A200").RemoveDuplicates Columns:=1, Header:=xlYes
      'Sort by column A
        Sheets(nme).Range("A4:XFD200").Sort key1:=Sheets(nme).Range("A5:A200"), order1:=xlAscending, Header:=xlYes

    End If
  End If

Next ws

' Deal Name For Loop
For Each ws In ActiveWorkbook.Worksheets
    nme = ws.Range("I3").Text
    Set Crng = ws.Range("A1")

    'Dont Copy Data from these worksheets
    If ws.Name <> "Portfolio" And ws.Name <> "Master" And ws.Name <> "Template" And ws.Name <> "Coal" And ws.Name <> "E&P" And ws.Name <> "Gas Gen" And ws.Name <> "Hydro" And ws.Name <> "LNG" And ws.Name <> "Midstream" And ws.Name <> "Solar" And ws.Name <> "Transmission" And ws.Name <> "Wind" Then
    'Storing Copied data into cell A4
    If IsEmpty(Sheets(nme).[A4]) Then
    Crng.Copy Sheets(nme).Range(4 & Columns.Count).End(xlLeft)
    'Storing next copied data below previously filled cell
      Else
          Crng.Copy Sheets(nme).Cells(4, Columns.Count).End(xlToLeft).Offset(0, 1)

    'Delete duplicates, this is the part that I am trying to change, so that the For Loop can ignore rather than delete

          Sheets(nme).Range("D4:XFD4").RemoveDuplicates Columns:=Array(4, 500), Header:=xlNo

    End If
End If

Next ws

Answer 1

这个选项是在第二个循环中进行排序，并使用第三个循环进行添加，例如：

Sheets(nme).Range("A4:XFD200").Sort key1:=Sheets(nme).Range("D5:D200"), order1:=xlAscending, Header:=xlYes

Dim i, j, k,l as integer

j=0
k=0
l=0

For i = 6 to 200 'based on your range
    l=l
    k=l
    If Cells(i,4).Value=Cells(i-1,4) Then
        'Nothing
    Else
        j=Cells(i,4).Value
        l=j+k
    End If
Next i

'Output l in the desired cell

对于循环遍历行的循环，仅添加唯一值

1 个答案: