ardışık istatistik

[polist]

selam arkadaşlar

A1 sütununda 1 den 100 e kadar karışık şekilde sıralanmış sayılarım var .

bunlardan ilk her hangi alt alta 3 tanesi ardışık olarak düşecek
4.sü bir önceki sayıdan yüksek olacak,
bu şart sağlandıgında şartın saglandıgı satırın B1 sutununa sayıyı vba olarak nasıl yazdırabılırız.
basit oldugunu dusundugumden örnek dosya hazırlamadım,
arzu edilirse ekleyebilirim.
iyi forumlar .

A1 B1
.
.
.
.
65
59
23
24 24
.
.
.

 

[Ömer]

Merhaba,

Deneyiniz.

Sub test()
    Dim i As Long, s As Double, ilk As Long
    ilk = 1
    Range("B1") = ""
    For i = ilk To Cells(Rows.Count, "A").End(xlUp).Row
        If i = ilk Then
            s = 9.99999999999999E+307
        Else
            s = Cells(i - 1, "A")
        End If
        If s > Cells(i, "A") And _
            Cells(i, "A") > Cells(i + 1, "A") And _
            Cells(i + 1, "A") < Cells(i + 2, "A") Then
            If i <> 1 Then
                Range("B1") = i - 1 & " .Satır"
                Exit Sub
            End If
        End If
    Next i
    MsgBox "Şarta uyan bulunamadı."
End Sub

 

[polist]

oldu teşekkür ederim..

 

[polist]

Merhaba,

Deneyiniz.

Sub test()
    Dim i As Long, s As Double, ilk As Long
    ilk = 1
    Range("B1") = ""
    For i = ilk To Cells(Rows.Count, "A").End(xlUp).Row
        If i = ilk Then
            s = 9.99999999999999E+307
        Else
            s = Cells(i - 1, "A")
        End If
        If s > Cells(i, "A") And _
            Cells(i, "A") > Cells(i + 1, "A") And _
            Cells(i + 1, "A") < Cells(i + 2, "A") Then
             Range("B1") = i - 1 & " .Satır"
             Exit Sub
        End If
    Next i
    MsgBox "Şarta uyan bulunamadı."
End Sub

ömer bey,

sayılar sütunda değilde satırda olsa nasıl yapabiliriz.

rowları columb filan yaptım ama olmadı

 

[Ömer]

Deneyiniz.

Sub test_sutun()
    Dim i As Long, s As Double, ilk As Long, sat As Long
    ilk = 1 'ilk değerin olduğu sütun indisi
    sat = 1 'değerlerin hangi satırda olduğu
    Range("A" & sat + 1) = ""
    For i = ilk To Cells(sat, Columns.Count).End(xlToLeft).Column
        If i = ilk Then
            s = 9.99999999999999E+307
        Else
            s = Cells(sat, i - 1)
        End If
        If s > Cells(sat, i) And _
            Cells(sat, i) > Cells(sat, i + 1) And _
            Cells(sat, i + 1) < Cells(sat, i + 2) Then
            If i <> 1 Then
                Range("A" & sat + 1) = i - 1 & " .Sütun"
                Exit Sub
            End If
        End If
    Next i
    MsgBox "Şarta uyan bulunamadı."
End Sub

 

[polist]

Deneyiniz.

Sub test_sutun()
    Dim i As Long, s As Double, ilk As Long, sat As Long
    ilk = 1 'ilk değerin olduğu sütun indisi
    sat = 1 'değerlerin hangi satırda olduğu
    Range("A" & sat + 1) = ""
    For i = ilk To Cells(sat, Columns.Count).End(xlToLeft).Column
        If i = ilk Then
            s = 9.99999999999999E+307
        Else
            s = Cells(sat, i - 1)
        End If
        If s > Cells(sat, i) And _
            Cells(sat, i) > Cells(sat, i + 1) And _
            Cells(sat, i + 1) < Cells(sat, i + 2) Then
            If i <> 1 Then
                Range("A" & sat + 1) = i - 1 & " .Sütun"
                Exit Sub
            End If
        End If
    Next i
    MsgBox "Şarta uyan bulunamadı."
End Sub

istediğim gibi oldu
teşekkür ederim elinize sağlık..

 

[polist]

Deneyiniz.

Sub test_sutun()
    Dim i As Long, s As Double, ilk As Long, sat As Long
    ilk = 1 'ilk değerin olduğu sütun indisi
    sat = 1 'değerlerin hangi satırda olduğu
    Range("A" & sat + 1) = ""
    For i = ilk To Cells(sat, Columns.Count).End(xlToLeft).Column
        If i = ilk Then
            s = 9.99999999999999E+307
        Else
            s = Cells(sat, i - 1)
        End If
        If s > Cells(sat, i) And _
            Cells(sat, i) > Cells(sat, i + 1) And _
            Cells(sat, i + 1) < Cells(sat, i + 2) Then
            If i <> 1 Then
                Range("A" & sat + 1) = i - 1 & " .Sütun"
                Exit Sub
            End If
        End If
    Next i
    MsgBox "Şarta uyan bulunamadı."
End Sub

ömer bey , aslında çok kolay görünüyor ama olmuyor ..
for j as interger fılan ile next dongusu kurmaya calıstım yapamadım
2 saattir filan uğraşıyorum ..

son kez bu konuda yardımcı olabılırsenız sevınırım .
a1 sutunundan başlayarak alt alta 5-10 tane olan datanın , for döngüsünü yukardaki kodların içine nasıl entegre edebılırız..

 

[Ömer]

Sorunuzu anlayamadım. Sütuna göre birden çok satıramı bakacak. Örneğin A1:F1, A2:G2, A3:J3.... gibi. Eğer öyleyse bulduğu veriyi nereye yazacak?
Daha detaylı açıklama yapınız. Örnek dosya ekleyerek de açıklayabilir siniz.

Dosya Yükle - Dosya Upload

Dosyalarınızı ücretsiz yükleyebilir ve paylaşabilirsiniz. Dosya yükleme, Dosya Upload ücretsiz.

dosya.co

 

[polist]

Sorunuzu anlayamadım. Sütuna göre birden çok satıramı bakacak. Örneğin A1:F1, A2:G2, A3:J3.... gibi. Eğer öyleyse bulduğu veriyi nereye yazacak?
Daha detaylı açıklama yapınız. Örnek dosya ekleyerek de açıklayabilir siniz.

Dosya Yükle - Dosya Upload

Dosyalarınızı ücretsiz yükleyebilir ve paylaşabilirsiniz. Dosya yükleme, Dosya Upload ücretsiz.

dosya.co

hocam her satırda 9 sayı var, bu sayıların en sonuna şarta uyanı ekleyebılırsenız guzel olur .
satır sayısı olarak a1 sutunundaki son dolu hucreye kadar kodu revıze edebılırsenız sevınırım..

örnek dosya ekledım .

İndir forum istatistik

Dosyayı indir forum istatistik

dosya.co

 

[Ömer]

Ardışık azalanı 3 demiştiniz, 2 ye mi düştü?

 

[polist]

Ardışık azalanı 3 demiştiniz, 2 ye mi düştü?

hocam yanlış yazmışım, rüyamda bile if else fılan olunca hatlar karıştı haklısınız 3 olacaktı , özür

 

[Ömer]

Deneyiniz.

Sub test()
    Dim i As Long, j As Integer, son_sut As Integer, s As Byte
    son_sut = 10
    Range(Cells(1, son_sut + 1), Cells(Rows.Count, son_sut + 1)) = ""
    For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
        For j = 2 To son_sut
            If Cells(i, j - 1) > Cells(i, j) And _
                Cells(i, j) > Cells(i, j + 1) And _
                Cells(i, j + 1) < Cells(i, j + 2) Then
                If j <> 2 Then
                    Cells(i, son_sut + 1) = j + 2 & " .Sütun"
                    s = 1
                    Exit For
                End If
            End If
        Next j
    Next i
    If s = 0 Then MsgBox "Şarta uyan bulunamadı."
End Sub

 

[polist]

Deneyiniz.

Sub test()
    Dim i As Long, j As Integer, son_sut As Integer, s As Byte
    son_sut = 10
    Range(Cells(1, son_sut + 1), Cells(Rows.Count, son_sut + 1)) = ""
    For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
        For j = 2 To son_sut
            If Cells(i, j - 1) > Cells(i, j) And _
                Cells(i, j) > Cells(i, j + 1) And _
                Cells(i, j + 1) < Cells(i, j + 2) Then
                If j <> 2 Then
                    Cells(i, son_sut + 1) = j + 2 & " .Sütun"
                    s = 1
                    Exit For
                End If
            End If
        Next j
    Next i
    If s = 0 Then MsgBox "Şarta uyan bulunamadı."
End Sub

teşekkür ederim hocam , elinize sağlık ..
kontrol ettim sıkıntı yok