Как сообщить о перекрывающихся значениях ячеек из 2 столбцов - PullRequest
0 голосов
/ 17 февраля 2019

У меня есть 2 набора временных рядов (дд / мм / гггг), потенциально начинающихся и заканчивающихся в разные периоды.Я хотел бы сообщить в другую ячейку обо всех перекрывающихся датах и ​​относительных данных, связанных с ними, которые присутствуют в обоих столбцах.

На приведенном ниже рисунке точно объясняются, какие данные у меня есть и что я хотел бы с ними сделать.

enter image description here

Выбрав 2 столбца, создав переменные и запустив цикл «foreach», я не знаю структуру кода для выполнения такой команды.

Sub overlap()
Dim c As Range


For Each c In Selection
    If c.Value
Next c


End Sub

1 Ответ

0 голосов
/ 17 февраля 2019

Не проверено, но для этого нужно:

    Option Explicit
    Sub Overlap()

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim LastRow As Long, LastCol As Long
    Dim rng As Range, Rng2 As Range
    Dim Cell As Variant, Double As Variant

    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("Whatever")


    LastRow = ws.Cells(wsV.Rows.Count, "A").End(xlUp).row
    Lastcol = ws.Cells(1, .Columns.Count).End(xlToLeft).Column
    'Your entire range, here in column A    
    Rng = ws.Range(ws.Cells(1, 1), ws.Cells(LastRow, LastCol))
    ' Loop through each cell of the Range
    For Each Cell in Rng
        'Set a new range, from the beginning of the orginal one to your current row
        Set Rng2 = ws.Range(ws.Cells(1,1), ws.Cells(Cell.Row,1))
        With Rng2
        Set Double = .Find(Cell.Value, LookIn:=xlValues, Lookat:=xlWhole)
        ' If double is not nothing you've found the value of the current cell
        ' Meaning there's more than one
        If Not Double Is Nothing Then
          'Here you found a duplicate value - Do what you need to do
        End If  
      End With
    Next Cell     

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...