verilere göre hangi aralıklarda 2 sütundaki değer aynı kalmış

[modoste]

ekli dosyamda sorumu ilettim

 

[modoste]

bu sorumda 2. biz isteğim daha olucak dosyamı güncelledim.

 

[ÖmerFaruk]

Cevaplar aşağıda

Sub istek1()
Dim Refer As Range
Dim Hedef As Range
Set Refer = Range("C3") 'Başka bir yerde denerken burdan değiştirebilirsiniz
Set Hedef = Range("I3") 'Başka bir yerde denerken burdan değiştirebilirsiniz

Hedef.Value = "Kilometre"
Hedef.Offset(0, 1) = "Kilometre"
Hedef.Offset(0, 2) = "Değer"
Satır = 0
For i = Refer.Row + 1 To Refer.End(xlDown).Row
    Do Until (Cells(i + x, Refer.Column + 1) <> Cells(i + x + 1, Refer.Column + 1) Or Cells(i + x, Refer.Column + 2) <> Cells(i + x + 1, Refer.Column + 2))
    x = x + 1
    Loop
    If x > 0 Then
        Satır = Satır + 1
        Hedef.Offset(Satır, 0) = Cells(i, Refer.Column)
        Hedef.Offset(Satır, 1) = Cells(i + x, Refer.Column)
        Hedef.Offset(Satır, 2) = Cells(i, Refer.Column + 1)
        i = i + x
        x = 0
    End If
Next i
End Sub

Sub istek2()
Dim Refer As Range
Dim Hedef As Range
Set Refer = Range("C3") 'Başka bir yerde denerken burdan değiştirebilirsiniz
Set Hedef = Range("N3") 'Başka bir yerde denerken burdan değiştirebilirsiniz

Hedef.Value = "Kilometre"
Hedef.Offset(0, 1) = "Kilometre"
Hedef.Offset(0, 2) = "Değer"
Satır = 0
For i = Refer.Row + 1 To Refer.End(xlDown).Row
j = 0
    Do Until (Cells(i + x, Refer.Column + 1) <> Cells(i + x + 1, Refer.Column + 1) Or Cells(i + x, Refer.Column + 2) <> Cells(i + x + 1, Refer.Column + 2))
    x = x + 1
    Loop
    If x > 0 Then
        If i > Refer.Row + 1 Then j = -1
        Satır = Satır + 1
        Hedef.Offset(Satır, 0) = Cells(i + j, Refer.Column)
        Hedef.Offset(Satır, 1) = Cells(i + x, Refer.Column)
        Hedef.Offset(Satır, 2) = Cells(i, Refer.Column + 2)
        i = i + x
        x = 0
    Else
        Satır = Satır + 1
        Hedef.Offset(Satır, 0) = Cells(i - 1, Refer.Column)
        Hedef.Offset(Satır, 1) = Cells(i + x, Refer.Column)
        Hedef.Offset(Satır, 2) = Cells(i, Refer.Column + 2)
        i = i + x
        x = 0
    End If
Next i
End Sub

 

[umut3550]

iyi çalışmalar

 

[modoste]

çözümler net ve doğru sonuçlar aldım çok teşekkür ederim
sayın Next Level

birde kapalı dosyalardan veri almakla ilgili sorumda en son iletimde resimelerle anlatmaya çalıştım. o sorumla tekrar bakabilir misiniz.