Soru KODUN HER SAYFADA ÇALIŞMASI

[itouchcanmedia]

Arkadaşlar söz konusu kodun kitabımdaki tek bir sayfada değilde her sayfada çalışabilmesi için nasıl olması gerekir. bir türlü yapamadım. Yardımcı olursanız çok mutlu olurum.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo hata
If Intersect(Target, [I2:I65536]) Is Nothing Then Exit Sub
Worksheets(Target.Text).Select
Exit Sub
hata:
MsgBox "sayfa yok", vbInformation, "ASKM"
End Sub

 

[Korhan Ayhan]

İlgili kodu "BuÇalışmaKitabı" bölümündeki "SelectionChange" olayına yazarsanız istediğiniz sonuca ulaşabilirsiniz.

 

[itouchcanmedia]

Harika bu kadar basitmiymiş çok çok teşekkürler... bilgi çok güzel birşey ve bunu paylaşmak daha da güzel.. peki bu kodun bazı sayfalarda çalışmamasını nasıl sağlarım? son olarak sadece bu kaldı.

 

[muratboz06]

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

if sh.Name = "Sayfa1" or "Sayfa2" Then
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub

If Target.Column = 9 Then ' I sütununda çalışır.
On Error GoTo hata
Application.EnableEvents = False
Worksheets(Target.Text).Select
Application.EnableEvents = True
Exit Sub
End If
end if

hata:
Application.EnableEvents = True
MsgBox "sayfa yok", vbInformation, "ASKM"

End Sub

Sayfa1 veya sayfa 2 de çalışır.

 

[itouchcanmedia]

murat bey çok çok teşekkürler ama tam tersiydi benim arzum. onu başaramamıştım. şöyle ki; Bu kod çalışma kitabındaki bütün sayfalarda çalışsın sadece birkaç sayfada yani örneğin ("muhasebe1","finans","demirbaş") isimli sayfalarda çalışmasın...Bu şekilde yapmaya çalışıyorum. Çalışmasını istemediğim sayfa isimleri de bunlar.

Yani çalışmasını istediğim değil, çalışmasını istemediğim sayfalara göre kodu düzenlemeye çalışıyorum... Yardımcı olursanız çok ama çok sevinirim.

 

[muratboz06]

Private sayfaName As String

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub

If Target.Column = 9 Then

On Error GoTo hata

sayfaName = Target.Value
Call SayfayaGit
Exit Sub
End If

hata:
MsgBox "sayfa yok", vbInformation, "ASKM"

End Sub

Sub SayfayaGit()
Set ws = ActiveSheet

If (ws.Name <> "muhasebe") And (ws.Name <> "finans") And (ws.Name <> "demirbaş") Then
Worksheets(sayfaName).Select
End If

End Sub

 

[itouchcanmedia]

Murat bey çalışıyor ancak şöyle bir sorun var. sayfalardaki ilgili hücreye çift tıkladıktan sonra "enter" e basınca çalışıyor. tek tıklama ile çalışmıyor böyle bir sorun oluştu.

 

[YUSUF44]

İlk satırı aşağıdaki gibi kullanın:


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

Sadece Change olursa sayfada değişiklik olduğunda (bahsettiğiniz enter olayı da değişikliktir) çalışır, selectionchange olunca sayfada hücre seçilirse çalışır.

 

[muratboz06]

Aşağıdaki kodu deneyiniz.

Private sayfaName As String

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub

    If Target.Column = 9 Then

        On Error GoTo hata

        sayfaName = Target.Value
        Call SayfayaGit
        Exit Sub
    End If

    hata:
    MsgBox "sayfa yok", vbInformation, "ASKM"

End Sub

Sub SayfayaGit()
    Set ws = ActiveSheet

    If (ws.Name <> "muhasebe") And (ws.Name <> "finans") And (ws.Name <> "demirbaş") Then
        Worksheets(sayfaName).Select
    End If

End Sub

 

[itouchcanmedia]

Aşağıdaki kodu deneyiniz.

Private sayfaName As String

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub

    If Target.Column = 9 Then

        On Error GoTo hata

        sayfaName = Target.Value
        Call SayfayaGit
        Exit Sub
    End If

    hata:
    MsgBox "sayfa yok", vbInformation, "ASKM"

End Sub

Sub SayfayaGit()
    Set ws = ActiveSheet

    If (ws.Name <> "muhasebe") And (ws.Name <> "finans") And (ws.Name <> "demirbaş") Then
        Worksheets(sayfaName).Select
    End If

End Sub

murat bey çok ama çok teşekkür ederim. utanarak bir isteğim daha olacak eğer mümkünse (beni çok mutlu ettiniz, çok sağolun, hem siz hem yardım eden düşünen bütün arkadaşlar...), bu konudan tamamen bağımsız bir çalışma kitabım var şöyleki;

Bütün sayfalardaki "e" sütununda sayısal veriler bulunmakta, aynı zamanda bu sayısal veriler birçok sayfanın adı konumunda, herhangi bir sayfadaki "E" sütunundaki bir hücrenin içeriği ile aynı ismi taşıyan bir sayfa var ise o hücrenin içindeki metnin rengi kırmızı (yada hücre dolgu rengi-herhangi bir şey olabilir ayırt etmek için sadece), aynı isimde bir sayfa ismi yok ise renklendirmeden olduğu gibi kalmasını sağlayabilecek bir kod oluşturamaz mıyız? (belirli sayfalarda çalışmayacak şekilde;"ürün ana sayfa","demirbaş ana sayfa") bunu yapabilirsek. çok mutlu edersiniz, şimdiden çok teşekkürler.

 

[itouchcanmedia]

Murat bey dediğimi yapabilme şahsımız var mı acaba? eğer yeni konu açmam gerekiyorsa açabilirim... ancak yeni konu açmadan destek olursanız çok müteşekkir olurum... Saygılarımla...

 

[muratboz06]

Aşağıdaki kodu module ekleyerek çalıştırınız.

Sub RenklendirSütunE()
Application.ScreenUpdating = False
    Dim sArr() As String
    ReDim sArr(1 To Worksheets.Count)
  
    For i = 1 To Worksheets.Count
        sArr(i) = Worksheets(i).Name
        sNames = Join(sArr, ":")
    Next i
  
    Dim ws As Worksheet
  
    sonSatır = Range("E1000000").End(xlUp).Row
    For Each ws In ThisWorkbook.Worksheets
        ws.Select
        ws.Range("E:E").Interior.ColorIndex = xlNone
        If (ws.Name <> "muhasebe") And (ws.Name <> "finans") And (ws.Name <> "demirbaş") Then
            For i = 1 To sonSatır
                If InStr(1, sNames, Range("E" & i).Value, 1) Then
                Range("E" & i).Interior.Color = vbRed
                End If
             Next i
        End If
    Next ws
    Worksheets(1).Select
    Application.ScreenUpdating = True
    MsgBox "İşlem tamamlandı."
End Sub

 

[metehan8001]

murat bey çok ama çok teşekkür ederim. utanarak bir isteğim daha olacak eğer mümkünse (beni çok mutlu ettiniz, çok sağolun, hem siz hem yardım eden düşünen bütün arkadaşlar...), bu konudan tamamen bağımsız bir çalışma kitabım var şöyleki;

Bütün sayfalardaki "e" sütununda sayısal veriler bulunmakta, aynı zamanda bu sayısal veriler birçok sayfanın adı konumunda, herhangi bir sayfadaki "E" sütunundaki bir hücrenin içeriği ile aynı ismi taşıyan bir sayfa var ise o hücrenin içindeki metnin rengi kırmızı (yada hücre dolgu rengi-herhangi bir şey olabilir ayırt etmek için sadece), aynı isimde bir sayfa ismi yok ise renklendirmeden olduğu gibi kalmasını sağlayabilecek bir kod oluşturamaz mıyız? (belirli sayfalarda çalışmayacak şekilde;"ürün ana sayfa","demirbaş ana sayfa") bunu yapabilirsek. çok mutlu edersiniz, şimdiden çok teşekkürler.

Sub exceldestek80()
''Metehan8001 / Feyzullah
For Each syf In Worksheets
If syf.Name <> "ürün ana sayfa" And syf.Name <> "demirbaş ana sayfa" Then
    For a = 2 To syf.Cells(Rows.Count, 5).End(xlUp).Row
        syf.Cells(a, 5).Interior.Color = xlNone
        For b = 1 To Worksheets.Count
            If Worksheets(b).Name = syf.Cells(a, 5) Then syf.Cells(a, 5).Interior.Color = vbRed: Exit For
    Next b, a
End If
Next
MsgBox "İşlem Tammamlandı", vbInformation + vbMsgBoxRtlReading, "Www.***************"
End Sub

 

[itouchcanmedia]

Murat bey çok güzel oldu ancak biz bu kodu sadece çalıştırınca aktif edebiliyoruz(doğru anlatamadığımı şimdi anladım.lütfen özrümü kabul edin) Benim arzu ettiğim şey ise kodun dinamik olmasıydı yani şöyle ki;

Ben herhangi bir sayfanın "E" sütunundayken, bu sütunun hücrelerinden hangisinin adında bir sayfa olduğunu hangisinin adında bir sayfa olmadığını anlayabilmeliyim (bu kod bunu sağlıyor buraya kadar sorun yok), ancak ben bunu anlamak için kod'u çalıştırmak zorunda kalıyorum. Bunu bulunduğum sayfa için otomatik olarak o anlık yapmasını istiyorum.(sayfadan çıktığımda renklendirme kalksın istiyorum)

Çünkü ben "E" sütununun en altındaki boş hücrelere ek veri girdiğimde de kodu tekrar çalıştırmam gerekecek. Yani ben sürekli kodu çalıştırmak zorundayım ki bu yüzlerce sayfa olunca epey uzun sürüyor. Bunu otomatikleştiremez miyiz? yani modülden kodu çalıştırmama gerek kalmadan hangi sayfaya gidersem sadece o sayfa için ve o an için bu işlemi otomatik olarak yapsa ancak sayfadan çıktığımda tekrar renklendirmeyi kaldırsa olmazmı?

NotSn. metehan8001 sebebini bilmiyorum ama sizin kodunuz çalışmadı. run-time error '13' hatası veriyor)

 

[muratboz06]

Linkteki örneği inceleyiniz.
Bu çalışma kitabı modülündeki kodları kendi excel dosyasınızdaki ilgili sayfaya kopyalayınız.

https://s4.dosya.tc/server6/cg8j1z/Kitap1.rar.html

 

[itouchcanmedia]

Linkteki örneği inceleyiniz.
Bu çalışma kitabı modülündeki kodları kendi excel dosyasınızdaki ilgili sayfaya kopyalayınız.

https://s4.dosya.tc/server6/cg8j1z/Kitap1.rar.html

Murat bey çok güzel oldu.. Çok teşekkür ederim.

 

[Korhan Ayhan]

Kullanıcı tanımlı fonksiyon ve koşullu biçimlendirme kullanılan alternatif dosyayı inceleyiniz.