vba - 将每个 ID 的最新修订复制到新工作表

Question

我有 4 列:Number、Title、Revision、ID。每行都有一个唯一的 ID。工作表按 ID 分组并排序，因此最新修订版位于顶部。

我正在尝试创建一个仅包含每个 ID 的最新修订的新工作表。

我的代码:

 Sub mySub()

    Dim j As Long
    j = 2 ' row 1 on sheet2 is headings

    Dim source As Excel.Worksheet 'source
    Dim target As Excel.Worksheet 'target
    Set source = ThisWorkbook.Worksheets("owssvr (1)") 'source sheet
    Set target = wb.Sheets.Add(Type:=xlWorksheet, _
        after:=Application.ActiveSheet) '("Sheet2") 'target sheet
    Sheets("owssvr (1)").Activate 'sheet with data

    For Each c In source.Range("D1:D5000") 'currently currently 5000 rows
        Dim alreadythere As Boolean 'already on sheet2?
        alreadythere = False 'not in sheet2 yet

' ***** "TYPE MISMATCH" ERROR on following line *****
        If c.Cells(4, 1).Value <> c.Offset(0, 1).Cells(4, 1).Value Then 

            For ctr = 1 To j 'checking from row 1 to last row in sheet2
                If c = target.Cells(ctr, 4) Then 'if it is in sheet2
                    alreadythere = True 'already exists
                End If
            Next ctr
            If alreadythere = False Then 'if its not in sheet2 already
                 source.Rows(c.Row).Copy 'copy
                 target.Rows(j).PasteSpecial Paste:=xlPasteValues 'paste
                 Application.CutCopyMode = False 'fix mode
                 j = j + 1 'count new row
            End If
        End If
    Next c
End Sub

数据示例和预期结果:

Number    Title    Revision    ID
1        Title 1     C       GH6YY
1        Title 1     B       GH6YY
1        Title 1     A       SDF212
2        Title 2     B       SDF212
2        Title 2     A       SDF212
3        Title 3     B       GTR3000
3        Title 3     A       GTR3000
3        Title 4     C       RTT24
3        Title 4     B       RTT24
3        Title 4     A       RTT24  

预期结果:

Number   Title    Revision   ID
1        Title 1     C       GH6YY
2        Title 2     B       SDF212
3        Title 3     B       GTR3000
3        Title 4     C       RTT24  

Answer 1

实际上有几种方法可以在几秒钟内完成，甚至无需使用 VBA。这是一种方法。

以您的示例数据为例，在 A 到 D 列中，我们希望隐藏除每个 ID 的第一次出现之外的所有内容:

• 在 E2 单元格中输入公式:

  =COUNTIF($D$2:D2,D2)
  

  ...然后将其复制或“填充”到第 5000 行或您的数据到多远。 (如有必要，请先插入一个新列——您可以在完成设置后随时隐藏它。)

• 在 Data 菜单下，单击 Filter。

• 在 E 列的Filter 菜单中，选择仅显示 1 的值。

除了最近的，一切都消失了。在屏幕底部，您会看到总行数和显示行数。此方法的另一个优点是即使列不按顺序也能正常工作。

现在我知道这不是一个切换按钮，但它非常接近。只是为了它，我也会为一个按钮拼凑一些代码。 (所以从技术上讲，它使用 VBA - 除了我要让 Excel 为我编写代码!)...

---

“切换”命令按钮:

添加命令按钮并附加以下代码(必要时更改按钮的名称和自动筛选列)

Sub Button1_Click()
    With ActiveSheet.Shapes("Button 1").TextFrame.Characters
        If .Text <> "Show All" Then
             'only most recent
            .Text = "Show All"
            ActiveSheet.Range("$A$1:$E$11").AutoFilter Field:=5, Criteria1:="1"
        Else
            'show all
            ActiveSheet.Range("$A$1:$E$11").AutoFilter Field:=5
            .Text = "Show Most Recent"
        End If
    End With
End Sub

---

如何按字母/编号系统排序

如前所述，您的 A→Z→AA→ZZ→ etc 编号系统还有很多不足之处，尤其是因为 Excel 不会以这种方式对字母进行排序。 (按字母顺序，AA 早于 Z。)

但我有一个想法:如有必要，您可以使用这种“偷偷摸摸”的方法，根据 Excel 的列号从字母中获取“数字”。

工作表公式:

=COLUMN(INDIRECT(A1&"1"))

VBA 函数:

Function numberFromRevision(revStr As String) As Long
    On Error Resume Next
    numberFromRevision = Range(revStr & "1").Column
End Function

两者都返回这样的结果:

最大列数:XFD = 16384 次修订。这可能会以您尚未考虑过的多种方式派上用场。 :)