• DİKKAT

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

Unvana Göre Oranı Bul ve Değiştir

K

Kemter

Katılım
30 Nisan 2011
Mesajlar
73
Excel Vers. ve Dili
Excel-2007-2010
Esselamuanaleykum sevgili form dostlarım makro bilgim olmadığı için ekteki dosyaya kod yazma imkanı olabilir mi? Gerekli açıklamalar dosya içerisinde örnekli olarak anlatmaya çalıştım. Hayırlı akşamlar.
 

Ekli dosyalar

Aleykumselam,
Liste sayfasında C2 ye aşağıdaki formülü yapıştırın köşesinden tutup aşağı çekin.

Kod: 
=EĞER(VE(B2>=DÜŞEYARA(A2;Veri!A:D;2;0);B2<=DÜŞEYARA(A2;Veri!A:D;3;0));DÜŞEYARA(A2;Veri!A:D;4;0);0)
 
Allah razı olsun formül olarak işlem tamam, mümkün ise vba kodu ile kullanmak istemiştim. Selametle kalınız.
 
Güzel duanıza çok teşekkür ederim, sağ olun.
 
turist bey merhabalar sizden bir istirhamım olabilir mi?
mesaj 4 deki dosyadaki kodu unvana göre olan değerleri VERİ sayfasındaki B, C ve D sütunundaki değerlere göre Liste sayfasındaki C sütununa yazdırma kodunu güncelleyebilir misini?
İyi akşamlar.
 
Tam olarak ne istiyorsunuz?
 
Mesaj 4 deki dosyadaki kodu VERİ sayfasındaki B, C arasındaki değerleri D sütunundaki değerleri, Liste sayfasındaki B sütunundaki değerlere göre C sütununa VERİ sayfasındaki D sütunundaki verileri yazdırmak istiyorum?
İlginiz için teşekkür ederim.
 
Ekli dosyada da açıklama yapmaya çalıştım inşallah anlatabilmişimdir.
Örnek 1 ile 5 olanların hepsi Liste sayfasının B sütunda olan değeri karşılık gelen değerin yenisi C Sutünuna yazdırmak istiyorum.
Örnek: 21 ile 25 arası olan değerilerin hepsi 6 olacak şekilde LİSTE sayfasındaki C sutünuna yazdırmak istiyorum.
Değerler küçük veya büyük ise 0(sıfır) olabilir hiç olmasa hatalı kayıtları bulunmuş olur.
 

Ekli dosyalar

Deneyiniz.

C++: 
Option Explicit

Sub Fast_Vlookup()
    Dim Zaman As Double, Dizi As Variant, X As Long, Veri_A As Integer, Veri_B As Integer
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Zaman = Timer
    
    Sheets("Liste").Range("C2:C" & Rows.Count).ClearContents
    
    Dizi = Sheets("Veri").Range("A1").CurrentRegion.Resize(, 4).Value
    
    With CreateObject("Scripting.Dictionary")
        For X = 2 To UBound(Dizi, 1)
            .Item(Dizi(X, 1)) = Dizi(X, 2) & "#" & Dizi(X, 3) & "#" & Dizi(X, 4)
        Next
        
        Dizi = Sheets("Liste").Range("A1").CurrentRegion.Resize(, 3).Value
        
        For X = 2 To UBound(Dizi, 1)
            If .Exists(Dizi(X, 1)) Then
                Veri_A = Split(.Item(Dizi(X, 1)), "#")(0)
                Veri_B = Split(.Item(Dizi(X, 1)), "#")(1)
                If Dizi(X, 2) >= Veri_A And Dizi(X, 2) <= Veri_B Then
                    Dizi(X, 3) = Split(.Item(Dizi(X, 1)), "#")(2)
                Else
                    Dizi(X, 3) = "Yok"
                End If
            Else
                Dizi(X, 3) = "Yok"
            End If
        Next
    End With
    
    Sheets("Liste").Range("A2:A" & Rows.Count).NumberFormat = "@"
    Sheets("Liste").Range("A1").CurrentRegion.Resize(, 3) = Dizi
    
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & _
           "İşlem süresi ; " & Format((Timer - Zaman), "0.00")
End Sub
 
Korhan Ayhan' Alıntı:
Deneyiniz.

C++: 
Option Explicit

Sub Fast_Vlookup()
    Dim Zaman As Double, Dizi As Variant, X As Long, Veri_A As Integer, Veri_B As Integer
  
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
  
    Zaman = Timer
  
    Sheets("Liste").Range("C2:C" & Rows.Count).ClearContents
  
    Dizi = Sheets("Veri").Range("A1").CurrentRegion.Resize(, 4).Value
  
    With CreateObject("Scripting.Dictionary")
        For X = 2 To UBound(Dizi, 1)
            .Item(Dizi(X, 1)) = Dizi(X, 2) & "#" & Dizi(X, 3) & "#" & Dizi(X, 4)
        Next
      
        Dizi = Sheets("Liste").Range("A1").CurrentRegion.Resize(, 3).Value
      
        For X = 2 To UBound(Dizi, 1)
            If .Exists(Dizi(X, 1)) Then
                Veri_A = Split(.Item(Dizi(X, 1)), "#")(0)
                Veri_B = Split(.Item(Dizi(X, 1)), "#")(1)
                If Dizi(X, 2) >= Veri_A And Dizi(X, 2) <= Veri_B Then
                    Dizi(X, 3) = Split(.Item(Dizi(X, 1)), "#")(2)
                Else
                    Dizi(X, 3) = "Yok"
                End If
            Else
                Dizi(X, 3) = "Yok"
            End If
        Next
    End With
  
    Sheets("Liste").Range("A2:A" & Rows.Count).NumberFormat = "@"
    Sheets("Liste").Range("A1").CurrentRegion.Resize(, 3) = Dizi
  
    Application.ScreenUpdating = True
  
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & _
           "İşlem süresi ; " & Format((Timer - Zaman), "0.00")
End Sub
Genişletmek için tıkla ...

Korhan bey emeğinize sağlık, şöyle bir durum oldu kısmi olarak çalışıyor. Ekran Görütüsü ekte.
Ekran Alıntısı.JPG
Örnek:6 10 arası olan rakamları tamamını 3 ile değişmesi gerekiyor.
Yeni Dosyayı mesaj 10 ekledim.
 
Ben ilk mesajınızdaki dosyaya göre kod önermiştim. Son dosyanızda durum farklı görünüyor. Müsait olduğumda dönüş yaparım.
 
Korhan Ayhan' Alıntı:
Ben ilk mesajınızdaki dosyaya göre kod önermiştim. Son dosyanızda durum farklı görünüyor. Müsait olduğumda dönüş yaparım.
Genişletmek için tıkla ...
Korhan bey yazmış olduğunuz kod çok güzel olmuş ve mükemmel hızlı çalışıyor.
Yeni kod içinde şimdiden teşekkür ederim.
İlginiz ve alakanız için Allah razı olsun.
 
Son düzenleme:
Eklediğiniz dosyada UNVAN kısmı boş görünüyor. Bu şekilde mi kullanacaksınız.

Çünkü benim önerdiğim kodlama bu sütunu dikkate alarak işlem yapıyordu.
 
Deneyiniz.

C++: 
Option Explicit

Sub Fast_Vlookup()
    Dim S1 As Worksheet, S2 As Worksheet, X As Long
    Dim Zaman As Double, Dizi As Variant, Y As Integer
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Zaman = Timer
    
    Set S1 = Sheets("Veri")
    Set S2 = Sheets("Liste")
    
    S2.Range("C2:C" & S2.Rows.Count).ClearContents
    
    Dizi = S1.Range("A1:D" & WorksheetFunction.Max(S1.Range("B:C"))).Value
    
    With CreateObject("Scripting.Dictionary")
        For X = 2 To UBound(Dizi, 1)
            For Y = Dizi(X, 2) To Dizi(X, 3)
                .Item(Y) = Dizi(X, 4)
            Next
        Next
        
        Dizi = S2.Range("A1").CurrentRegion.Resize(, 3).Value
        
        For X = 2 To UBound(Dizi, 1)
            If .Exists(Dizi(X, 2)) Then
                Dizi(X, 3) = .Item(Dizi(X, 2))
            Else
                Dizi(X, 3) = "Yok"
            End If
        Next
    End With
    
    S2.Range("A2:A" & S2.Rows.Count).NumberFormat = "@"
    S2.Range("A1").CurrentRegion.Resize(, 3) = Dizi
    
    Set S1 = Nothing
    Set S2 = Nothing
    
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & _
           "İşlem süresi ; " & Format((Timer - Zaman), "0.00")
End Sub
 
Korhan bey emeğinize sağlık çok güzel olmuş ve hızlı çalışıyor.
Bu kodu dosyadaki liste butonuna bastığımda çalıştıramıyorum. Vba bilgim olmadığı için bunun için buton eklene bilinir mi?
Kolay gelsin.
 
 
Korhan Bey emeğinize sağlık Allah razı olsun.
Vermiş olduğunuz linkleri inceleyerek yapamaya çalışacağım.
Selametle kalınız.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst