Question

我使用excel以下列形式跟踪某些数据：

Date    Name   ID

1/01,   A,     1

1/01,   B,     2

1/02,   C,     3

1/02,   D,     4

1/03,   E,     5

我想根据这些数据设置一个计划，但为了做到这一点，我需要找到并输出具有相同日期的样本的范围。

示例：

1/01: IDs 1-2

1/02: IDs 3-4

1/03: ID 5

我该怎么做呢？我尝试使用查找，但在处理重复数据时它会变得非常混乱（并且它只能以任何速率找到一个实例）。

澄清：

基本上，我想找到所有具有日期1/02的值，并获取具有这些日期的最低和最高ID。

Answer 1

以下是我理解的符合您要求的代码。

我假设列“A”包含显示格式为mm / dd的Excel日期。

对于经验丰富的VBA程序员来说，这是一项微不足道的任务，所以我假设你不是VBA程序员或缺乏经验。我避免使用更高级的功能。但是，我使用了格式（日期显示为mm / dd，粗体，对齐），这是您没有要求的，以向您展示它是如何完成的。我没有告诉你如何访问VB编辑器或如何创建模块。如果您不知道，请询问。我曾经有人在错误的地方放了一些代码，这很难解释如何解决它。

我曾说过什么声明或声明正在做什么，但没有提供完整的解释。我们的想法是告诉您足够的内容，允许您对代码进行微小的更改，并允许您在“帮助”中查看功能，如果您想要更进一步。我建议你走得更远。一旦你越过第一座山，VBA的大部分都是平坦的乡村。但是，如果你想更进一步，有一些严重的山脉。

我假设所有的ID都是整数。如果它们是字符串，则必须将IdCrnt，SummaryIdFirst和SummaryIdLast的类型从Integer更改为String。如果它们是如“1”，“2”，“2a”，“2b”，“3”，“4”等值，则会出现问题，因为“10”小于“1a”。

我已将摘要放在源工作表“Sheet1”中未使用的列中。根据需要更改With语句中工作表的名称。

Option Explicit

  ' I assume the sample data in your question is a simplification
  ' with many irrelevant columns omitted.  The use of constants means
  ' that you can change the columns used by changing the following
  ' four statements.
  Const ColSrcDate As Integer = 1     ' "A"
  Const ColSrcId As Integer = 3       ' "C"
  Const ColDestDate As Integer = 6    ' "F"
  Const ColDestId As Integer = 7      ' "G"
Sub SummariseTasks()

  Dim DateCrnt As Date
  Dim Found As Boolean
  Dim IdCrnt As Integer
  Dim RowCrnt As Integer
  Dim RowLast As Integer

  ' I have used three arrays to hold the summary data.  There are better
  ' techniques but I think this is the easiest for a beginner.
  Dim SummaryDate() As Date
  Dim SummaryIdFirst() As Integer   ' Change type
  Dim SummaryIdLast() As Integer    ' as necessary

  Dim InxSummaryCrnt As Integer     ' One index for all three arrays
  Dim InxSummaryCrntMax As Integer

  With Sheets("Sheet1")

    ' Find the last row on the worksheet
    RowLast = .Cells.SpecialCells(xlCellTypeLastCell).Row

    ' Size arrays to bigger than could be required and use
    ' InxSummaryCrntMax to identify the last entry used.
    ' You can use Redim Preserve to make an array bigger but
    ' I avoid using Redim Preserve more than necessary because
    ' it is expensive in memory and time.
    ReDim SummaryDate(1 To RowLast)
    ReDim SummaryIdFirst(1 To RowLast)
    ReDim SummaryIdLast(1 To RowLast)
    InxSummaryCrntMax = 0

    ' Most experienced programmers would load the entire source range
    ' into an array.  We now know that using arrays is not that much
    ' faster than accessing individual cells within the worksheet so
    ' I have gone for simplicity.

    ' Introduction to syntax of addressing a worksheet
    '   .Cells      The entire worksheet identified by the With statement
    '   .Cells(R,C) The single cell with row = R and column = C.  R must
    '               be an integer while C can be a letter or a number with
    '               "A"=1. "B"=2. etc.

    For RowCrnt = 2 To RowLast
      If IsEmpty(.Cells(RowCrnt, ColSrcDate).Value) Then
        ' I assume that if the date column is empty, the row is empty
      Else
        ' Extract values to variables
        DateCrnt = .Cells(RowCrnt, ColSrcDate).Value
        IdCrnt = .Cells(RowCrnt, ColSrcId).Value
        ' Look for date in SummaryDate array
        Found = False
        For InxSummaryCrnt = 1 To InxSummaryCrntMax
          If SummaryDate(InxSummaryCrnt) = DateCrnt Then
            Found = True
            Exit For
          End If
        Next
        If Found Then
          ' This date already recorded.  Update IdFirst
          ' and IdLast if necessary.
          If SummaryIdFirst(InxSummaryCrnt) > IdCrnt Then
            SummaryIdFirst(InxSummaryCrnt) = IdCrnt
          End If
          If SummaryIdLast(InxSummaryCrnt) < IdCrnt Then
            SummaryIdLast(InxSummaryCrnt) = IdCrnt
          End If

        Else
          ' First time this date found, Create
          ' new entry in summary arrays.
          InxSummaryCrntMax = InxSummaryCrntMax + 1
          SummaryDate(InxSummaryCrntMax) = DateCrnt
          SummaryIdFirst(InxSummaryCrntMax) = IdCrnt
          SummaryIdLast(InxSummaryCrntMax) = IdCrnt
        End If
      End If
    Next

  End With

  ' The source data is now summarised in the Summary arrays.
  ' I have not sorted by date.  This is possible if the source rows
  ' are not in date order but I would need more information to
  ' identify the best approach.

  With Sheets("Sheet1")

    ' Erase any data from a previous run of this macro.
    ' Erase any formatting in case you have used bold or strikeout
    ' to highlight particular tasks as important or done
    With .Columns(ColDestDate).EntireColumn
      .ClearContents
      .ClearFormats
    End With
    With .Columns(ColDestId).EntireColumn
      .ClearContents
      .ClearFormats
    End With

    ' Create column headers
    With .Cells(1, ColDestDate)
      .Value = "Date"
      .Font.Bold = True
      .HorizontalAlignment = xlRight
    End With
    With .Cells(1, ColDestId)
      .Value = "Id range"
      .Font.Bold = True
      .HorizontalAlignment = xlCenter
    End With

    ' Store summary data
    RowCrnt = 2
    For InxSummaryCrnt = 1 To InxSummaryCrntMax
      With .Cells(RowCrnt, ColDestDate)
        .NumberFormat = "mm/dd"
        .Value = SummaryDate(InxSummaryCrnt)
      End With
      With .Cells(RowCrnt, ColDestId)
        .Value = "'" & SummaryIdFirst(InxSummaryCrnt) & "-" & _
                       SummaryIdLast(InxSummaryCrnt)
        .HorizontalAlignment = xlCenter
      End With
      RowCrnt = RowCrnt + 1
    Next

  End With
End Sub

祝你好运。

查找重复数据的范围并确定开始和结束ID

1 个答案: