搜索列并评估excel中的相邻单元格

时间:2014-05-21 01:17:04

标签: excel vba excel-vba

我试图制作一个电子表格,可以告诉我某人何时同时做两件事。比如A列包含名称,B列有时间符号,C表示退出时间。我试图找到一种方法来评估同名的任何其他实例在时间和时间内是否重叠。我考虑过Vlookup,但这只能让我进入第一个实例。

基本上我正在寻找是否(此行中的A存在于A列中的任何其他位置且相邻的B单元格> =此行的B单元格和相邻的C单元格> =此行&# 39; s C细胞,然后是真的,否则做其他事情)

我在机械加工厂工作,人们同时工作两台机器非常普遍。我刚才理解我的例子只是时间重叠的几种可能方式之一,但如果我能得到帮助那么远,我会欣喜若狂。甚至把我指向最广泛的方向,如果没有学习编码,那就不可能了。会有所帮助。

我的excel技能主要限于我在帮助文件中学到的东西,截至目前我对ifs没问题。任何帮助,将不胜感激。我需要为此学习VBA吗?

1 个答案:

答案 0 :(得分:0)

我不是Excel高级用户。我学习了VBA,因为雇主为我提供了Excel,但不允许我使用其他可编程工具。我从未认真使用Excel的更高级功能。有很多问题可以得到评论,#34;你可以用数据透视表来表达这个问题"但从来没有解释过如何。关于数据透视表的公平问题属于超级用户网站,但我觉得这是一个非常无益的评论。

我不知道也不关心您的要求是否可以通过数据透视表来满足。我希望展示如何使用VBA解决简单的任务,即使它们无法通过高级Excel功能解决。下面的宏没多久就写了,我相信它符合你的要求。

是的,你应该学习VBA。学习基础知识并不需要很长时间,它可以用来解决许多简单的问题。我无法想象无法创建宏或程序来解决日常问题。

在网上搜索" Excel VBA教程"。有很多可供选择。尝试一些并完成符合您学习风格的一个。我更喜欢书籍和在线教程。我访问了一个大型图书馆并检查了他们的Excel VBA Primers。然后我买了最适合我的那个。

我承认下面的宏背后有很多练习,但我相信真正的技能是将您的需求分解为可以使用Excel VBA轻松解决的步骤。

我创建了一个工作表Log,其中填充了与我对数据理解相符的数据。也许你的员工不会同时运行这么多机器,但我想彻底测试我的宏。

Worksheet Log

宏创建此工作表的副本(如果您不希望对其进行排序)并将其命名为Temp。然后它按名称和登录时间对Temp进行排序,以给出:

Worksheet Temp

宏比较相邻行和副本重叠到工作表重叠:

Worksheet Overlap

最后删除工作表Temp。

我的目标是完全解释代码的作用,而不是宏如何做。一旦您知道存在语句,通常很容易查找。如有必要,请回答问题,但是你越能自己解读,你的技能发展得越快。

Option Explicit
Sub FindOverlap()

  Dim RowOverCrnt As Long
  Dim RowTempCrnt As Long
  Dim RowTempLast As Long
  Dim WithinOverlap As Boolean
  Dim WshtLog As Worksheet
  Dim WshtOver As Worksheet

  ' My principle reason for using worksheet objects is so the names appear in a single place.

  Set WshtLog = Worksheets("Log")       ' Change Log to your name for the source worksheet
  Set WshtOver = Worksheets("Overlap")  ' Change Log to your name for the destination worksheet

  ' Create temporary copy of worksheet "Log" in case sequence must be preserved.
  ' This is not necessary if you do not care if worksheet Log is sorted.
  WshtLog.Copy After:=Sheets(Worksheets.Count)
  Sheets(Worksheets.Count).Name = "Temp"

  ' Clear any existing data from destination worksheet and copy the headings from the
  ' source worksheet
  With WshtOver
    .Cells.EntireRow.Delete
    WshtLog.Rows(1).Copy Destination:=.Range("A1")
  End With
  RowOverCrnt = 2       ' First to which rows from worksheet Log will be copied

  ' Sort worksheet Temp by Name and Sign-in time
  With Worksheets("Temp")
    With .Cells
      .Sort Key1:=.Range("A2"), Order1:=xlAscending, _
            Key2:=.Range("B2"), Order2:=xlAscending, _
            Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
    End With

    ' This is the VBA equivalent of selecting the cell at the bottom of column A
    ' and clicking Ctrl+Up.  With the keyboard, this move the cursor up to the first
    ' cell with a value and selects that cell.  That is, it selects the last cell from
    ' the top with a value.  This statement sets RowTempLadst to the row number of that
    ' cell.
    RowTempLast = .Cells(Rows.Count, "A").End(xlUp).Row

    WithinOverlap = False     ' Not currently within a set of rows that overlap.
    ' I assume row 2 is the first data row.  This loop checks a row for an overlap with
    ' the previous row.  This is why the start row is 3.
    For RowTempCrnt = 3 To RowTempLast
      If .Cells(RowTempCrnt, "A").Value = .Cells(RowTempCrnt - 1, "A").Value And _
         .Cells(RowTempCrnt, "B").Value < .Cells(RowTempCrnt - 1, "C").Value Then
        ' The current row and the previous row are for the same person and
        ' the start time of the current row is before the end time of the previous row
        If WithinOverlap Then
          ' Previous rows have overlapped and have been copied to worksheet Overlap.
          ' Add current row to end of current set of overlaps
          .Rows(RowTempCrnt).Copy Destination:=WshtOver.Cells(RowOverCrnt, "A")
          RowOverCrnt = RowOverCrnt + 1     ' Advance to next free row
        Else
          ' The current and previous rows overlap.  Copy both to worksheet Overlap.
          .Rows(RowTempCrnt - 1 & ":" & RowTempCrnt).Copy _
                                        Destination:=WshtOver.Cells(RowOverCrnt, "A")
          RowOverCrnt = RowOverCrnt + 2     ' Advance to next free row
          WithinOverlap = True   ' Record within overlap set
        End If
      Else
        ' Current row does not overlap with previous
        If WithinOverlap Then
          ' An overlap set has ended
          RowOverCrnt = RowOverCrnt + 1     ' Leave gap between overlap sets
          WithinOverlap = False             ' Record no longer within overlap set
        End If
      End If
    Next RowTempCrnt

  End With

  ' Delete worksheet Temp
  ' "Application.DisplayAlerts = False" suppresses the "Are you sure you want to delete
  ' this worksheet?" question.
  Application.DisplayAlerts = False
  Worksheets("Temp").Delete
  Application.DisplayAlerts = True

End Sub