Kodda Hata

[ALTINYAYLA]

Private Sub Worksheet_Calculate()
Dim S1 As Worksheet, Bul As Range, Satir As Long
Dim Maksimum As Double, Minimum As Double

Set S1 = Sheets("Euro Kur")
Set Bul = S1.Range("A:A").Find(Date)
If Not Bul Is Nothing Then
Minimum = WorksheetFunction.Min(S1.Range("B" & Bul.Row, "C" & Bul.Row), Range("C3"))
Maksimum = WorksheetFunction.Max(S1.Range("B" & Bul.Row, "C" & Bul.Row), Range("C3"))
Bul.Offset(, 1) = Minimum
Bul.Offset(, 2) = Maksimum
Else
Satir = S1.Cells(Rows.Count, 1).End(3).Row + 1
S1.Cells(Satir, 1) = Date
S1.Cells(Satir, 2) = Range("C3")
End If
End Sub
arkadaşlar bu kodu "Euro Kur" sayfasında Kullanıyorum. "Dolar Kur" ve "Altın Kur" diye iki kod daha altına ekledim Hata verdi ne yapmalıyım... Dolarınki C2 Altınınki C4 olacak.

 

[Ömer BARAN]

Aynı sayfa için, Sayfa olaylarına (Calculate) ilişkin kod sadece 1 adet olabilir.
İşlemleri ayrı sayfalarda yaparsanız sorun olmaz.

Örnek belge eklerseniz daha hızlı sonuca ulaşırsınız.

 

[ALTINYAYLA]

Ama ömer bey o kodu kurların alındığı sayfaya eklemem"ki o sayfa 1 tane" gerekiyor ama yveri yazılacak sayfa 3 degişik sayfa soruun orada onu yapamadım

 

[Ömer BARAN]

Belirttiğim gibi, hatalı haliyle kodların da içerisinde olduğu ve yapmak istediğiniz işlemi açıklayıcı not ekleyerek,
gerçek belgenizin (özel bilgi içermeyecek şekilde) bir kopyasını eklerseniz mutlaka sonuca ulaşırsınız.

 

[ALTINYAYLA]

Her sayfaya her 1 dakikada kontrol yapıp verileri ilgil sayfaya Ekleyip/Güncellemeli. ama yukarııdaki hata yı veriyor

 

[Ömer BARAN]

Tekrar merhaba.

Kurlar sayfasının kod bölümündeki kodların tümünü silip, aynı yere aşağıdakini yapıştırın.

Private Sub Worksheet_Calculate()
    Dim S1, S2, S3 As Worksheet, Bul1, Bul2, Bul3 As Range, Sat1, Sat2, Sat3 As Long
    Dim Mak1, Mak2, Mak3 As Double, Min1, Min2, Min3 As Double
    
    Set wf = WorksheetFunction: Set S1 = Sheets("Dolar Kur")
    Set S2 = Sheets("Euro Kur"): Set S3 = Sheets("Altın Kur")
    
    Set Bul1 = S1.Range("A:A").Find(Date)
    Set Bul2 = S2.Range("A:A").Find(Date)
    Set Bul3 = S3.Range("A:A").Find(Date)
    
    If Not Bul1 Is Nothing Then
        Min1 = wf.Min(S1.Range("B" & Bul1.Row, "C" & Bul1.Row), [C1])
            Mak1 = wf.Max(S1.Range("B" & Bul1.Row, "C" & Bul1.Row), [C1])
                Bul1.Offset(, 1) = Min1: Bul1.Offset(, 2) = Mak1
                    Else
                        Sat1 = S1.Cells(Rows.Count, 1).End(3).Row + 1
                            S1.Cells(Sat1, 1) = Date: S1.Cells(Sat1, 2) = [C1]
                                End If
                                    If Not Bul2 Is Nothing Then
                                        Min2 = wf.Min(S2.Range("B" & Bul2.Row, "C" & Bul2.Row), [C2])
                                            Mak2 = wf.Max(S2.Range("B" & Bul2.Row, "C" & Bul2.Row), [C2])
                                                Bul2.Offset(, 1) = Min2: Bul2.Offset(, 2) = Mak2
                                                Else
                                            Sat2 = S2.Cells(Rows.Count, 1).End(3).Row + 1
                                        S2.Cells(Sat2, 1) = Date: S2.Cells(Sat2, 2) = [C2]
                                    End If
                                If Not Bul3 Is Nothing Then
                            Min3 = wf.Min(S3.Range("B" & Bul3.Row, "C" & Bul3.Row), [C3])
                        Mak3 = wf.Max(S3.Range("B" & Bul3.Row, "C" & Bul3.Row), [C3])
                    Bul3.Offset(, 1) = Min3: Bul3.Offset(, 2) = Mak3
                Else
            Sat3 = S3.Cells(Rows.Count, 1).End(3).Row + 1
        S3.Cells(Sat3, 1) = Date: S3.Cells(Sat3, 2) = [C3]
    End If
End Sub

 

[ALTINYAYLA]

Merhaba Ömer hocam çok teşekkür ederim Emeğine sağlık çok güzel oldu. Bu belgeye başka bir sayfa eklesek Tüm Kurlar diye 3 bölüme ayrılmış bir sayfaya ve tek sayfa da gösterilen ona nasıl bir kod uygulamamız lazım .

 

[Ömer BARAN]

Şu an bilgisayar başında değilim.
İşleyişe engel olmadığı sürece belge sahibinin tasarımında değişiklik önerme alğşkanlığım yok.

Uygun olduğumda bakmaya çalışırım.

 

[ALTINYAYLA]

Alakanız ve emeğiniz için teşekkür ederim.

 

[Ömer BARAN]

Estağfurullah, mesele değil.

Şu anda haftasonu olduğundan bilgi akışı yok sanırım.
O nedenle de deneme şansım yok, hafta içerisinde bakalım ki (umarım unutmam ve fırsat bulurum) kontrol etme şansımız olsun.
Önceki cevabımda yaptığım sadece kodları birleştirmekten ibaretti, umarım yeni durumu halledebilirim.
.

 

[ALTINYAYLA]

Anladım Ömer bey. Pazar Saat 00:00 dan itibaren akış başlıyor. İnşallah fırsatınız olur. Selamlarımla...

 

[ALTINYAYLA]

Estağfurullah, mesele değil.

Şu anda haftasonu olduğundan bilgi akışı yok sanırım.
O nedenle de deneme şansım yok, hafta içerisinde bakalım ki (umarım unutmam ve fırsat bulurum) kontrol etme şansımız olsun.
Önceki cevabımda yaptığım sadece kodları birleştirmekten ibaretti, umarım yeni durumu halledebilirim.
.

Hocam Umarım fırsatınız olur. Selâmlarımla...

 

[ALTINYAYLA]

Bu kod çok güzel çalışıyor ancak tarih formatını örneğin 13 Ekim tarihini 13.10.2018 şeklinde değilde 10.13.2018 şeklinde gösteriyor ne yapılabilir acaba? Selam ve saygılar...

 

[ALTINYAYLA]

içeriği silinmiş mesaj (Tamamen kaldırılmadığından)

 

[ALTINYAYLA]

Tekrar merhaba.

Kurlar sayfasının kod bölümündeki kodların tümünü silip, aynı yere aşağıdakini yapıştırın.

Private Sub Worksheet_Calculate()
    Dim S1, S2, S3 As Worksheet, Bul1, Bul2, Bul3 As Range, Sat1, Sat2, Sat3 As Long
    Dim Mak1, Mak2, Mak3 As Double, Min1, Min2, Min3 As Double
   
    Set wf = WorksheetFunction: Set S1 = Sheets("Dolar Kur")
    Set S2 = Sheets("Euro Kur"): Set S3 = Sheets("Altın Kur")
   
    Set Bul1 = S1.Range("A:A").Find(Date)
    Set Bul2 = S2.Range("A:A").Find(Date)
    Set Bul3 = S3.Range("A:A").Find(Date)
   
    If Not Bul1 Is Nothing Then
        Min1 = wf.Min(S1.Range("B" & Bul1.Row, "C" & Bul1.Row), [C1])
            Mak1 = wf.Max(S1.Range("B" & Bul1.Row, "C" & Bul1.Row), [C1])
                Bul1.Offset(, 1) = Min1: Bul1.Offset(, 2) = Mak1
                    Else
                        Sat1 = S1.Cells(Rows.Count, 1).End(3).Row + 1
                            S1.Cells(Sat1, 1) = Date: S1.Cells(Sat1, 2) = [C1]
                                End If
                                    If Not Bul2 Is Nothing Then
                                        Min2 = wf.Min(S2.Range("B" & Bul2.Row, "C" & Bul2.Row), [C2])
                                            Mak2 = wf.Max(S2.Range("B" & Bul2.Row, "C" & Bul2.Row), [C2])
                                                Bul2.Offset(, 1) = Min2: Bul2.Offset(, 2) = Mak2
                                                Else
                                            Sat2 = S2.Cells(Rows.Count, 1).End(3).Row + 1
                                        S2.Cells(Sat2, 1) = Date: S2.Cells(Sat2, 2) = [C2]
                                    End If
                                If Not Bul3 Is Nothing Then
                            Min3 = wf.Min(S3.Range("B" & Bul3.Row, "C" & Bul3.Row), [C3])
                        Mak3 = wf.Max(S3.Range("B" & Bul3.Row, "C" & Bul3.Row), [C3])
                    Bul3.Offset(, 1) = Min3: Bul3.Offset(, 2) = Mak3
                Else
            Sat3 = S3.Cells(Rows.Count, 1).End(3).Row + 1
        S3.Cells(Sat3, 1) = Date: S3.Cells(Sat3, 2) = [C3]
    End If
End Sub

Bu kod çok güzel çalışıyor ancak tarih formatını örneğin 13 Ekim tarihini 13.10.2018 şeklinde değilde 10.13.2018 şeklinde gösteriyor ne yapılabilir acaba? Selam ve saygılar...

 

[Ömer BARAN]

Merhaba.
Verdiğim kod cevabını, cevabımdan önceki mesajınıza eklediğiniz belgeyi indirip
Kurlar sayfasının kod bölümüne yapıştırdım ve çalışmasını sağladığımda; ben bir sorun göremiyorum.

Herhangi bir hücreyi seçip =BUGÜN() formülünü uyguladığınızda aldığınız sonuç nedir?
Yine AY.GÜN.YIL mı yoksa olması gerektiği gibi GÜN.AY.YIL mı acaba?

Eğer yukarıdaki formülün sonucu da TERS ise, DENETİM MASASI >>SAAT-DİL-BÖLGE >> BİÇİM kısmından,
varsayılan tarih gösterim şeklini kontrol ediniz.
Belki de kullandığınız başka bir makro kodu ayarları değiştirmiştir ya da hatırlamıyorsunuz ama belki de kendiniz tarihlerin gösterim şeklini değiştirmişsinizdir.

 

[ALTINYAYLA]

Düzeldi çok teşekkür ederim Ömer bey...