Calculando a distância (linhas) entre dois mesmos valores em uma tabela

Question

Eu tenho um código VBA para calcular a distância entre duas células com os mesmos valores em uma tabela. Eu só preciso da diferença de linha entre as células que podem estar em colunas diferentes, como visto na imagem. Eu preciso apenas de distância no eixo "Y", não no eixo "X". Esse código tem a funcionalidade e o design de que preciso, mas também calcula a distância no eixo "X".

Na imagem de exemplo abaixo, na coluna B, B5: Central corresponde ao B12: Central mais próximo (abaixo), e a distância (o número de linhas entre eles) é 6. E em E1: 250 combina com o mais próximo G16: 250 , e a distância é 13.

Ocódigoquetenhoéeste:

OptionExplicitSubmain()DimcellAsRange,fAsRangeDimrowOffsetAsLongWithWorksheets("gaps").Range("A2:F10") '<--| change this to your actual range of interest
        For Each cell In .SpecialCells(xlCellTypeConstants, xlNumbers)
            rowOffset = 1
            Set f = .Find(what:=cell, after:=cell, LookIn:=xlValues, lookat:=xlWhole, searchdirection:=xlPrevious)
            If Not f Is Nothing And f.Row <= cell.Row Then rowOffset = cell.Row - f.Row + 1
            cell.offset(, .Columns.Count + 1) = rowOffset '<--| the "+1" offset results range one column away from values range: adjust it as per your needs
        Next cell
    End With
End Sub

    

Answer 1

Aqui está uma solução que encontrei para esse problema, abordando os problemas que eu tinha nos códigos oferecidos.

Sub Intervals()
    Dim r As Range, c As Range
    With Cells(1).CurrentRegion
        With .Offset(1).Resize(.Rows.Count - 1)
            For Each r In .Cells
                Set c = .Find(r.Value, r, , 1, , , 2)
                If (c.Address <> r.Address) * (c.Row > r.Row) Then
                    r.Offset(, 13) = c.Row - r.Row - 1
                Else
                    r.Offset(, 13) = "na"
                End If
            Next
        End With
    End With
End Sub 

    

Answer 2

Calcule as linhas

Sub main4()
Dim cell As Range, f As Range
Dim RowOffset As String
With Worksheets("gaps").Range("A2:F10") '<--| change this to your actual range of interest
    For Each cell In .SpecialCells(xlCellTypeConstants, xlNumbers)
        RowOffset = "na"
        Set f = .Find(what:=cell, after:=cell, LookIn:=xlValues, lookat:=xlWhole, searchdirection:=xlNext)
        If (f.Row <> cell.Row) Or (f.Row <> cell.Row) Then RowOffset = f.Row - cell.Row
        cell.Offset(, .Columns.Count + 1) = RowOffset '<--| the "+1" offset results range one Row away from values range: adjust it as per your needs
    Next cell
End With
End Sub

colunas de cálculo

Sub main2()
Dim cell As Range, f As Range
Dim ColOffset As String
With Worksheets("gaps").Range("A2:F10") '<--| change this to your actual range of interest
    For Each cell In .SpecialCells(xlCellTypeConstants, xlNumbers)
        ColOffset = "na"
        Set f = .Find(what:=cell, after:=cell, LookIn:=xlValues, lookat:=xlWhole, searchdirection:=xlNext)
        If (f.Column <> cell.Column) Or (f.Row <> cell.Row) Then ColOffset = f.Column - cell.Column
        cell.Offset(, .Columns.Count + 1) = ColOffset '<--| the "+1" offset results range one column away from values range: adjust it as per your needs
    Next cell
End With
End Sub

Ou melhor ainda, você pode indicar a linha e a coluna na célula:

Sub main3()
Dim cell As Range, f As Range
Dim Offset As String

With Worksheets("gaps").Range("A2:F10") '<--| change this to your actual range of interest
    For Each cell In .SpecialCells(xlCellTypeConstants, xlNumbers)
        Offset = "na"
        Set f = .Find(what:=cell, after:=cell, LookIn:=xlValues, lookat:=xlWhole, searchdirection:=xlNext)
        If (f.Column <> cell.Column) Or (f.Row <> cell.Row) Then Offset = (f.Column - cell.Column) & ";" & (f.Row - cell.Row)
        cell.Offset(, .Columns.Count + 1) = Offset '<--| the "+1" offset results range one column away from values range: adjust it as per your needs
    Next cell
End With
End Sub