Aranan araç nosuna göre en büyük ve en küçük değer

[kelkitli]

Aranan araç nosuna göre en büyük ve en küçük değer

Değerli Dostlar Selamlar,
Ektaki dosyada Sayfa1 B sütununda 1000 araca yakın mükerrersiz plaka no yazılı. Sayfa2 F sütununda da 10 larca kez tekrarlı belki 100.000 plaka numarası yazılı. Ancak Sayfa1 deki plakaların tekrarından müteşekkil. Beinm istediğim Sayfa1 C ve D sütunlarında En büyük ve en küçük dönem değerlerini görmek.

 

[Levent Menteşoğlu]

Dizi formülüyle yapmış olduğum çözümü ekliyorum. Şunuda hatırlatmak istiyorum. Bu istediğinizi formüllerle yaparsanız sayfa2 deki taranan satır sayısı arttıkça dosyanız kilitlenecektir.

 

[muygun]

Slm.
Levent hocam çözmüş ama uzun yoldan bir çözümde benden.
(Not: gri hücreleri veri çokluğuna göre çoğaltın.)

 

[kelkitli]

Sayın Levent Üstadım, Sayın muygun,
Cevaplarınız için teşekkür ederim. Tam çözüm. Sağolun.

 

[kelkitli]

Sn.Levent Hocam,
Gerçek verileri aktarınca kilitleniyor. Peki bunu makro ile yapmanız mümkünmü.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Sub EN_KÜÇÜK_VE_EN_BÜYÜK_DÖNEMLER()
    Application.Calculation = xlCalculationManual
    Sheets("Sayfa1").Select
    [C2:D65536].ClearContents
    Sheets("Sayfa2").Columns(3).Copy Sheets("Sayfa2").Columns(11)
    Sheets("Sayfa2").Columns(11).Replace "-", ""
    Sheets("Sayfa2").Range("B2") = "1"
    Sheets("Sayfa2").Range("B2").AutoFill Destination:=Sheets("Sayfa2").Range("B2:B" & Sheets("Sayfa2").Range("C65536").End(3).Row), Type:=xlFillSeries
    Sheets("Sayfa2").Range("A2:IV65536").Sort Key1:=Sheets("Sayfa2").Range("F2"), Order1:=xlAscending, Key2:=Sheets("Sayfa2").Range("K2") _
    , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
    False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
    For X = 2 To [B65536].End(3).Row
    EN_KÜÇÜK = Evaluate("=MIN(IF(Sayfa2!F2:F65536=" & "B" & X & ",ROW(2:65536)))")
    EN_BÜYÜK = Evaluate("=MAX(IF(Sayfa2!F2:F65536=" & "B" & X & ",ROW(2:65536)))")
    If EN_KÜÇÜK = 0 Then
    Cells(X, 3) = ""
    Else
    Cells(X, 3) = Sheets("Sayfa2").Cells(EN_KÜÇÜK, "C")
    End If
    If EN_BÜYÜK = 0 Then
    Cells(X, 4) = ""
    Else
    Cells(X, 4) = Sheets("Sayfa2").Cells(EN_BÜYÜK, "C")
    End If
    Next
    Sheets("Sayfa2").Range("A2:IV65536").Sort Key1:=Sheets("Sayfa2").Range("B2"), Order1:=xlAscending, _
    Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
    Sheets("Sayfa2").Range("B:B,K:K").Clear
    Application.Calculation = xlCalculationAutomatic
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[kelkitli]

Sayın Korhan Ayhan teşekkür ederim. Harikasınınız.