Question

基本上我正在尝试使用Excel和VBA来查询工作表的新值，对查询数据运行一些检查和计算，并归档符合特定条件的行。我将当前工作表交叉引用到存档工作表，并且任何尚未存档的工作表中的行都将复制到它。我正在使用两个for循环遍历每个工作表中的ID，但正如我所知道的那样，一旦行数变得显着，宏变得非常缓慢。我已经尝试使用带变体的范围示例，但只能在列之间进行比较以返回列值而不是整行。

我的循环代码示例如下：

Dim ALastRow As Long, ALastCol As Long
With ActiveSheet
    ALastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    ALastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With

Dim iRow2 As Integer, counter As Integer, IDrow As Integer, match As Integer
Dim This_Sheet4 As Worksheet

ActiveWorkbook.Sheets(QueryArray(i, 1)).Activate
Set This_Sheet4 = ThisWorkbook.Sheets(Archive)

counter = 1
IDrow = 5
For iRow = 2 To LastRow2
    match = 0
    For iRow2 = 2 To ALastRow
        If match = 0 Then
            If iRow2 = ALastRow Then
                    If ThisWorkbook.Sheets(QueryArray(i, 1)).Cells(iRow, 12).Value > 1.11111111111111E-02 Then
                            If ThisWorkbook.Sheets(QueryArray(i, 1)).Cells(iRow, IDrow).Value = ThisWorkbook.Sheets(Archive).Cells(iRow2, IDrow).Value Then
                            match = 1
                            Else
                            ThisWorkbook.Sheets(QueryArray(i, 1)).Rows(iRow).Copy Destination:=ThisWorkbook.Sheets(Archive).Rows(ALastRow + counter)
                            counter = counter + 1
                            ActiveWorkbook.Sheets(Archive).Activate
                            Cells(iRow2, 1).Select
                            End If
                        End If
                Else
                    If ThisWorkbook.Sheets(QueryArray(i, 1)).Cells(iRow, IDrow).Value = ThisWorkbook.Sheets(Archive).Cells(iRow2, IDrow).Value Then
                    match = 1
                    Else
                    ActiveWorkbook.Sheets(QueryArray(i, 1)).Activate
                    Cells(iRow, 1).Select
                    End If
                End If
            Else
            End If
        Next iRow2
    Next iRow
Next

Answer 1

如果你能够在当前的工作表数据中添加一列（我隐藏它，所以没有人改变它！），你可以简单地让宏填充一个值 - “x”，时间戳等 - 在这个“存档行后存档的“列”。然后，当您运行宏来存档符合相应条件的列时，您可以

1）将表过滤到Criteria1：= vbNullString以仅获取未归档的行并使用myRange.SpecialCells（xlCellTypeVisible）

示例：

Dim currentSheet as Worksheet
Dim TblLength as long
Dim Table as string

Table = "TableName"
Set currentSheet = ActiveSheet

With currentSheet.Range(Table)
   TblLength = .Columns(1).Rows.Count
   'clear any existing filters
   .AutoFilter  

   'set new filters
   .AutoFilter Field:=currentSheet.Range(Table & "[Transferred]").Column, Criteria1:=vbNullString
End With

If currentSheet.Range("A1:A" & TblLength + 1).Columns(1).SpecialCells(xlCellTypeVisible).Count - 1 > 0 Then
  'make sure we have visible rows
  Set CopyRange = currentSheet.SpecialCells(xlCellTypeVisible).Copy
  'other code
End If

或

2）遍历当前工作表中的所有行并测试If Range（“Table [Archived]”）（Row）= vbNullString以判断您是否已将其存档。

示例：

For Row = 1 To Range(Table).Rows.Count
   If Range(Table & "[Archived]")(Row) = vbNullString Then
          'your code here
   End if
Next Row

或者，您可以按其中一列对archiveSheet进行排序 - 例如，如果列出证券销售和购买，则通过Cusip列。然后你可以让你的第一个循环通过currentSheet，并通过archiveSheet测试对内循环进行第一次检查，以查看cusips是否匹配。这样，一旦你在archiveSheet中超过了那个cusip，就可以退出循环 - 仍然需要大量的循环，但是要少一点！

示例：

archiveSheet.Sort Key1:="Cusip", order1:=xlAscending, header:=xlYes

For iRow2 = 2 To ALastRow
    match = 0
    'assuming the cusip is in column A...
    myCusip = currentSheet.Range("A" & iRow2).Value
    'we want to know if we've reached it yet
    cusipMatched = false
    For iRow = 2 To LastRow2

        If myCusip = archiveSheet.Range("A" & iRow).Value Then
           cusipMatched = true
           'your code to check if the row matches
        Else
           If cusipMatched Then
              'we've already reached our cusip, so now we are past it
              ' this exits the current For loop and continues on in the outer For loop
              Exit For
           End if
        End if
   Next iRow
Next iRow2

如何使用Excel VBA比较两个工作表并保留具有唯一ID的行

1 个答案: