• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Belli bir sapma ile aynı dataları ayırma

  • Konbuyu başlatan Konbuyu başlatan kes888
  • Başlangıç tarihi Başlangıç tarihi
Katılım
29 Mayıs 2009
Mesajlar
2
Excel Vers. ve Dili
office 2003
Herkese kolay gelsin arkadaşlar okulda yaptığım bir çalışmada yardımınıza ihtiyaç duydum. Ekteki dosyada A ve B sütünlarında datalar var ve bunlar birbirinden farklı miktardalar. Benim ihtiyacım olan A ve B sütünlarındaki dataların belli bir sapmayla aynı olanlarını bir şekilde belli edilmesi D ve E sütünlarına yazılabilirler ya da aynı renkle renklendirilirler ya da sizin aklınıza gelen bir şeyde olabilir.

örnek olarak:

A14 hücresinde 6.1073 B17 hücresinde 6.1051 var eğer ben 0.003'lük bir sapma vermişsem bu iki değer yukarıda belirttiğim şekilde renklendirilmeli ya da farklı iki sütüna yan yana yazılmalı.

Ben çözüm bulabilmek için ilk olarak koşullu biçimlendirme denedim fakat orda sadece tıpatıp aynıysalar sonuc alabildim ve bütün değerleri aynı renk yapıyor şöyleki farklı 2 değer 2 sütünda da varsa onların ikisini birden kırmızı yapıyor mesela ben yine tek tek gözle kontrol etmek zorunda kalıyorum.

Düşeyara denedim ondada başarılı olamadım en yakın değeri getirdi ama oda işe yaramadı en yakın değeri getirmedi.

Bana bir örnek yollayabilirseniz ya da bir fikir sunabilirseniz çok sevinirim.
 

Ekli dosyalar

Merhaba,
Forumumuza hoş geldiniz.
Dosyanız ektedir.
Kod:
Sub Bul()
If ActiveCell.Value = "" Or ActiveCell.Column <> 1 Then
    MsgBox "A Sütununda Veri İçeren Hücre Seçmelisiniz !!", vbCritical, "U Y A R I"
    Exit Sub
End If
Range("D:E").ClearContents
Marj = Application.InputBox("Lütfen sapma değerini giriniz.", "SAPMA DEĞERİ")
If Marj = False Then Exit Sub
L = Replace((ActiveCell.Value - Marj), ",", ".")
H = Replace((ActiveCell.Value + Marj), ",", ".")
Range("B1").AutoFilter 2, ">=" & L, xlAnd, "<=" & H
Range("B:B").SpecialCells(xlCellTypeVisible).Copy Range("E1")
[D1] = [A1]
Range("B1").AutoFilter
ss = Range("E" & Rows.Count).End(3).Row - 1
Range("D2").Resize(ss, 1) = ActiveCell
End Sub
 

Ekli dosyalar

  • test.rar
    test.rar
    256.9 KB · Görüntüleme: 14
Teşekkürler

Çok teşekkürler elinize sağlık.
 
Geri
Üst