垂直搜索&比较A列并输出最新日期

Question

我正在尝试制作一个在列中搜索相同值的 vba 代码，然后从 B 列返回最新日期 例如：

    column A     B            output C
    -------------------------------------
         102     12.01.2016   12.01.2016
         102     17.10.2015
         102     25.12.2015
         105     30.03.2015
         105     01.01.2016   01.01.2016

它应该在 A 列中搜索不同的值。如果它一个接一个地找到相同的值，那么它将从对应的B列中搜索最新的日期并在C列中输出 请帮我一个vba代码。 谢谢你

Sub Cauta()
'Finds the last non-blank cell in a single row or column

Dim lRow As Long
Dim lCol As Long
Dim k, t, i, j As Long
Dim stvalue As Integer
Dim lsvalue As Integer
Dim data As Date

    'Find the last non-blank cell in column A(1)
    lRow = Cells(Rows.Count, 2).End(xlUp).row
    For i = 2 To lRow
        stvalue = Cells(i, 2)
        t = 0
        For j = i To lRow
        If stvalue = Cells(j + 1, 2) Then
        t = t + 1
        Else: j = lRow
        data = Cells(j, 3)
        For k = i To i + t
        If Cells(k, 3) < Cells(k + 1, 3) Then data = Cells(k + 1, 3)
        Next k
        Cells(i + t, 6).Value = data
        End If
        Next j

        i = i + t
    Next i
End Sub

Answer 1

我将从我所做的更改开始，以便我理解您的代码。

请完全缩进您的代码；它更容易阅读，也更容易调试。

当您编写Dim k, t, i, j As Long 时，只有j 被声明为Long。 k、t 和 i 没有类型，因此声明为 Variant。 Variant 变量更大更慢，更容易导致错误。

请不要使用k、t、i 和j 等变量名称。今天你可能还记得这些名字代表什么，但是当你在几个月后回到这个宏时你会记得它们是什么吗？即使您知道它们是什么，查看您的代码的其他人也不会知道。正如我推断出您的代码所做的那样，我已将这些名称替换为有意义的名称。

变量名lRow 稍微好一点，但在我看来，也好不了多少。很多人在他们的变量名前加上代表他们类型的代码。鉴于此，我将lRow 解释为Long Row，因为变量的类型为Long。我不给我的名字加前缀，我更喜欢更长、更明确的名字，比如RowLast。

如果你写 For A = B To C ... Next 你不能在循环中改变 A 或 C。您没有更改C，但您确实尝试更改A。您可以重新排列代码以便无需更改 A，也可以切换到 Do While 循环：

A = B
Do While A <= C
  :   :   :   :
Loop

我已切换到Do While 循环，因为它对您的代码所做的更改最少。

当您编写Dim stvalue As Integer 时，stvalue 被声明为 16 位整数。 16 位整数需要在 32 位和 64 位计算机上进行特殊处理，应避免使用。使用类型Long。

在您的问题中，表格的布局显示您使用的是“A”、“B”和“C”列或 1、2 和 3。您的代码使用了 2、3 和 6 列。我不知道是哪一个是正确的，但最好不要在这样的代码中使用列号。假设添加了新的第 1 列。您必须通过代码将每 2 替换为 3、3 替换为 4 和 6 替换为 7。您不能只使用全局替换，因为代码中可能还有其他 2、3 和 6。最好使用常量来定义列号。它们使代码更易于阅读和维护，因为 2、3 和 6 只出现一次。

考虑：

  For j = i To lRow
    If stvalue = Cells(j + 1, 2) Then
      t = t + 1

j 的最后一个值将是 lRow + 1。最好写：

  For j = i + 1 To lRow
    If stvalue = Cells(j, 2) Then
      t = l + 1

For j = i + 1 To lRow 循环查找有多少行具有与行i 相同的Id。在该循环中，您有 For k = i To i + t 来检查相同的行。两个问题： (1) 当k 循环结束时，你继续j 循环。 (2) 您的问题是，如果有多个具有相同 ID 的行，您只需要输出列中的值。我已将嵌套的 k 循环设为一个单独的循环，并对其周围的多行进行测试。

您的日期格式为“dd.mm.yyyy”。这可能是您所在国家/地区的默认格式，但不是我的默认格式。当您将日期写入输出列时，它将以您所在国家/地区的默认格式显示。为避免出现问题，我为输出列设置了数字格式。

我的最终代码如下。我相信我已经充分解释了我的更改，但如有必要，我会提出问题。

Option Explicit
Sub Cauta()
  'Finds the last non-blank cell in a single row or column

  Const ColId As Long = 1      '\
  Const ColDate As Long = 2    '| Change these values as necessary
  Const ColOutput As Long = 3  '/


  Dim DateNewest As Date
  Dim IdFirst As Long
  Dim NumSameAsFirst As Long
  Dim RowCrnt As Long
  Dim RowLast As Long
  Dim RowNewest As Long
  Dim RowTemp As Long


    'Find the last non-blank cell in column A(1)
    RowLast = Cells(Rows.Count, 2).End(xlUp).Row

    RowCrnt = 2
    Do While RowCrnt <= RowLast
      IdFirst = Cells(RowCrnt, ColId)
      NumSameAsFirst = 0
      ' Count the number of rows with the same Id as RowCrnt
      For RowTemp = RowCrnt + 1 To RowLast
        If IdFirst = Cells(RowTemp, ColId) Then
          NumSameAsFirst = NumSameAsFirst + 1
        Else
          Exit For
        End If
      Next RowTemp
      If NumSameAsFirst > 0 Then
        DateNewest = Cells(RowCrnt, ColDate)
        RowNewest = RowCrnt
        For RowTemp = RowCrnt + 1 To RowCrnt + NumSameAsFirst
          If DateNewest < Cells(RowTemp, ColDate) Then
            DateNewest = Cells(RowTemp, ColDate)
            RowNewest = RowTemp
          End If
        Next RowTemp
        With Cells(RowNewest, ColOutput)
          .Value = DateNewest
          .NumberFormat = "dd.mm.yyyy"
        End With
      End If
      RowCrnt = RowCrnt + NumSameAsFirst + 1
    Loop  ' While RowCrnt <= RowLast
End Sub