• DİKKAT

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

Koşula göre en büyük değeri getirmesi

L

Lecay

Katılım
3 Ekim 2011
Mesajlar
89
Excel Vers. ve Dili
Excel 2013 ENG
Koşula göre en büyük değeri getirmesini istediğim makroda bir hata var ve çözemedim. Yardım edebilir misiniz ?

** Sheet3'te Gana7065053'ün değeri daha büyük fakat kod Sheet1'e Gana5025053'ü yazıyor.
 

Ekli dosyalar

Merhaba;
Doğru anladıysam eki deneyin. (yada kodları kendinize göre güncelleyin)
İyi çalışmalar.
 

Ekli dosyalar

@muygun teşekkürler. kodun yapması gereken şu;
* Sheet1'deki D sütununda yazacak her numaraya göre Sheet2'de E sütunundaki değişkenlere bakacak then;
* Bu değişkenlerden Sheet3'te D sütununda hangisi büyük ise Sheet3'teki C sütunundaki metini Sheet1 L sütununa yazacak.
 

Ekli dosyalar

Yardım edebilecek olan var mı arkadaşlar ?
 
Yardım edebilecek olan var mı arkadaşlar ?
 
Yardım edebilecek olan var mı arkadaşlar ?
 
Deneyiniz.

C++: 
Option Explicit

Sub Last_Route_Code()
    Dim S1 As Worksheet, S2 As Worksheet, S3 As Worksheet
    Dim Son_A As Long, Son_B As Long, Son_C As Long, Dizi As Object
    Dim X As Long, Liste_A As Variant, Liste_B As Variant, Zaman As Double
    Dim Y As Long, Z As Long, Rota As Variant, Veri As Double, Route_Code As String
    
    Zaman = Timer
    
    Set S1 = Sheets("Sheet1")
    Set S2 = Sheets("Sheet2")
    Set S3 = Sheets("Sheet3")

    S1.Range("L3:L" & Rows.Count).ClearContents
    
    Set Dizi = CreateObject("Scripting.Dictionary")
    
    Son_A = S1.Cells(S1.Rows.Count, 2).End(3).Row
    
    Liste_A = S1.Range("B3:L" & Son_A).Value
    
    For X = LBound(Liste_A) To UBound(Liste_A)
        If Liste_A(X, 3) <> "" Then
            Son_B = S2.Cells(S2.Rows.Count, 2).End(3).Row
            For Y = 2 To Son_B
                If S2.Cells(Y, 2) <> "" Then
                    If Liste_A(X, 3) = S2.Cells(Y, 2) Then
                        Dizi(S2.Cells(Y, 5).Value) = 1
                    End If
                End If
            Next
    
            Son_C = S3.Cells(S3.Rows.Count, 3).End(3).Row
            Liste_B = S3.Range("C2:D" & Son_C).Value
            
            For Z = 1 To UBound(Liste_B)
                For Each Rota In Dizi.Keys
                    If Liste_B(Z, 1) = Rota Then
                        If Liste_B(Z, 2) > Veri Then
                            Veri = Liste_B(Z, 2)
                            Route_Code = Liste_B(Z, 1)
                        End If
                    End If
                Next
            Next
            If Route_Code <> "" Then
                Liste_A(X, 11) = Route_Code
                Route_Code = ""
            End If
            Veri = 0
        End If
    Next

    S1.Range("B3").Resize(UBound(Liste_A), 11) = Liste_A

    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub
 
Merhaba,

#4 nolu mesajdaki dosyanızda denedim. Aşağıdaki sonucu alıyorum.

Route Code
Gana7065053
 
Asıl dosyanızda işlem süresi nedir?
 
@Korhan Ayhan ufak bir hata ile karşı karşıya kaldım. 1 den fazla Shipment ile makroyu çalıştırdığımda her shipment için ayrı last route code getirmiyor
 
Örnek dosya ekleyiniz.
 
Ektedir. Örnekte de göreceğiniz üzre 2 numaralı shipment için gelen değer yanlış. Bu makroyu çok fazla shipment için çalıştıracağım bu sebeple her shipment içerisinde en uzak olanı bulmalı ve işlemeli.
 

Ekli dosyalar

Üstteki mesajımda ki kodu revize ettim. Tekrar deneyiniz.
 
evet şimdi süper oldu, çok teşekkürler Korhan bey
 
@Korhan Ayhan selam,

Sheet2'deki veri tek satır olduğunda makro boş dönüyor. Bunu nasıl düzeltebilirim ?
 

Ekli dosyalar

Sorun sizin Sheet2'de değil.

Kod içinde Sheet3 sayfasının son satırını bulan kod Sheet2 olarak kalmış. Üstteki mesajımda gerekli düzenlemeyi yaptım.

Tekrar deneyiniz.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst