Satıları yukarı kaydırma hk.

HACI46

Altın Üye
Katılım
5 Aralık 2015
Mesajlar
113
Excel Vers. ve Dili
windows 10 Pro TR

Ömer BARAN

Uzman
Katılım
8 Mart 2011
Mesajlar
13,002
Excel Vers. ve Dili
Office 2013 ( 32 bit ) TÜRKÇE
Merhaba.

-- Öncelikle belgenizde C5 hücresindeki formülü =0+B7 olarak değiştirin ve C5 ve D5 hücrelerinin biçimini TARİH olarak ayarlayın.
Böylece, C5 ve D5 hücreleri ile N3 hücresindeki veri doğrulama listesinin ilk satırındaki veri de TARİH halini alır.
-- Alt taraftan Sayfa1'adına fareyle sağ tıklayıp KOD GÖÖRÜNTÜLEyi seçin,
-- Açılan VBA ekranında sağdaki boş alana aşağıdaki kod blokunu yapıştırın.
NOT: YIL veya AY seçimi değiştirildiğinde; istenilen işlemin gerçekleşmesi için, TARİH seçiminin de yenilenmesi gerekir.
Zira kod, N3 hücresindeki seçime göre tetiklenmektedir.

Rich (BB code):
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [N3]) Is Nothing Then Exit Sub
If Target <> "" And Target.Address(0, 0) = "N3" And _
    WorksheetFunction.CountIf([G:G], Target) > 0 Then
    adres = Cells(WorksheetFunction.Match(Target, [G:G], 0), 7).Address(0, 0)
    [P3].Hyperlinks(1).SubAddress = "Sayfa1!" & adres
Else: MsgBox "Seçilen tarih G sütununda YOK!", vbCritical
End If
End Sub
 
Son düzenleme:

HACI46

Altın Üye
Katılım
5 Aralık 2015
Mesajlar
113
Excel Vers. ve Dili
windows 10 Pro TR
Merhaba.

-- Öncelikle belgenizde C5 hücresindeki formülü =0+B7 olarak değiştirin ve C5 ve D5 hücrelerinin biçimini TARİH olarak ayarlayın.
Böylece, C5 ve D5 hücreleri ile N3 hücresindeki veri doğrulama listesinin ilk satırındaki veri de TARİH halini alır.
-- Alt taraftan Sayfa1'adına fareyle sağ tıklayıp KOD GÖÖRÜNTÜLEyi seçin,
-- Açılan VBA ekranında sağdaki boş alana aşağıdaki kod blokunu yapıştırın.
NOT: YIL veya AY seçimi değiştirildiğinde; istenilen işlemin gerçekleşmesi için, TARİH seçiminin de yenilenmesi gerekir.
Zira kod, N3 hücresindeki seçime göre tetiklenmektedir.

Rich (BB code):
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [N3]) Is Nothing Then Exit Sub
If Target <> "" And Target.Address(0, 0) = "N3" And _
    WorksheetFunction.CountIf([G:G], Target) > 0 Then
    adres = Cells(WorksheetFunction.Match(Target, [G:G], 0), 7).Address(0, 0)
    [P3].Hyperlinks(1).SubAddress = "Sayfa1!" & adres
Else: MsgBox "Seçilen tarih G sütununda YOK!", vbCritical
End If
End Sub
Ömer bey çok teşekkür ederim, Gönderdiğiniz kodu uyguladım çalıştı, bunu şimdi asıl çalışma sayfama da uygulayacağım.
Bu dosyamı E-Mail le başka birimlere gönderdiğimde karşı bilgisayarda açmama, çalışmama gibi bir durum olmaz değil mi.
Ben sizlere tekrar çok teşekkür eder işlerinizde başarılar dilerim.
İyi ki varsınız bu forum sayesinde excellde bilmediğimiz bir çok şeyi sayenizde öğreniyoruz.
Tüm forum üyelerine selamlar.
 

Ömer BARAN

Uzman
Katılım
8 Mart 2011
Mesajlar
13,002
Excel Vers. ve Dili
Office 2013 ( 32 bit ) TÜRKÇE
Tekrar merhaba.
Verdiğim cevabın uygulandığı belge artık MAKRO İÇERİR hale geleceğinden;
belgeyi göndereceğiniz kişiler dosyayı ilk kez açarken MAKROLARI ETKİNLEŞTİRMELİdir (bu işlem 1 kez yapılır).
MAKROLAR ETKİNLEŞTİRilmeden kodlar işlem yapmayacaktır.
 

HACI46

Altın Üye
Katılım
5 Aralık 2015
Mesajlar
113
Excel Vers. ve Dili
windows 10 Pro TR
Tekrar merhaba.
Verdiğim cevabın uygulandığı belge artık MAKRO İÇERİR hale geleceğinden;
belgeyi göndereceğiniz kişiler dosyayı ilk kez açarken MAKROLARI ETKİNLEŞTİRMELİdir (bu işlem 1 kez yapılır).
MAKROLAR ETKİNLEŞTİRilmeden kodlar işlem yapmayacaktır.
Tamam Ömer bey anladım,
Yalınız bu VBA kodlunu kendi dosyama uyarlamaya çalıştım ama olmadı, Değişen hücreleri VBA da değiştim ama İngilizce olunca bir yerlerde anlamadığım bir şeyler var herhalde. Aşağıdaki altını çizdiğim hücreleri yeni dosyada denk gelen Hücre no ile değiştirdim olmadı.
Yeni dosyamı yükledim size zahmet müsait olunca hatamı düzelte bilirmisiniz.

Selamlar, İyi tatiller.

http://s3.dosya.tc/server18/27u3si/TARIH_SECME-2.xlsx.html

http://s3.dosya.tc/server18/27u3si/TARIH_SECME-2.xlsx.html




Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [N3]) Is Nothing Then Exit Sub
If Target <> "" And Target.Address(0, 0) = "N3" And _
WorksheetFunction.CountIf([G:G], Target) > 0 Then
adres = Cells(WorksheetFunction.Match(Target, [G:G], 0), 7).Address(0, 0)
[P3].Hyperlinks(1).SubAddress = "Sayfa1!" & adres
Else: MsgBox "Seçilen tarih G sütununda YOK!", vbCritical
End If
End Sub
 

Ömer BARAN

Uzman
Katılım
8 Mart 2011
Mesajlar
13,002
Excel Vers. ve Dili
Office 2013 ( 32 bit ) TÜRKÇE
Alt taraftan İŞLETME_RAPORU sayfasının adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEYİ seçin,
açılan VBA ekranında sağdaki boş alana aşağıdaki kod'u yapıştırın.
.
Rich (BB code):
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [W3]) Is Nothing Then Exit Sub
If Target <> "" And Target.Address(0, 0) = "W3" And _
    WorksheetFunction.CountIf([F:F], Target) > 0 Then
    [X3].ClearContents
    adres = ActiveSheet.Name & "!" & Cells(WorksheetFunction.Match(Target, [F:F], 0), 6).Address(0, 0)
    ActiveSheet.Hyperlinks.Add Anchor:=[X3], Address:="", SubAddress:=adres, TextToDisplay:="GİT"
Else
    [X3].Hyperlinks.Delete
    MsgBox "Seçilen tarih F sütununda YOK!", vbCritical
End If
End Sub
 

HACI46

Altın Üye
Katılım
5 Aralık 2015
Mesajlar
113
Excel Vers. ve Dili
windows 10 Pro TR
Alt taraftan İŞLETME_RAPORU sayfasının adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEYİ seçin,
açılan VBA ekranında sağdaki boş alana aşağıdaki kod'u yapıştırın.
.
Rich (BB code):
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [W3]) Is Nothing Then Exit Sub
If Target <> "" And Target.Address(0, 0) = "W3" And _
    WorksheetFunction.CountIf([F:F], Target) > 0 Then
    [X3].ClearContents
    adres = ActiveSheet.Name & "!" & Cells(WorksheetFunction.Match(Target, [F:F], 0), 6).Address(0, 0)
    ActiveSheet.Hyperlinks.Add Anchor:=[X3], Address:="", SubAddress:=adres, TextToDisplay:="GİT"
Else
    [X3].Hyperlinks.Delete
    MsgBox "Seçilen tarih F sütununda YOK!", vbCritical
End If
End Sub
Çok teşekkür ederim ömer bey.
Tamam inşallah p.tesi denerim.
Sağolun iyi tatiller selamlar
 

HACI46

Altın Üye
Katılım
5 Aralık 2015
Mesajlar
113
Excel Vers. ve Dili
windows 10 Pro TR
Ömer bey merhaba, Bu kodu aynen uyguladım ama çalıtırmadı.
Selamlar.
Ömer bey tamam
["End If
End Sub"]
burayı maustan kaçırmışım. Tamam çalıştı çok teşekkür ederim.
Selamlar iyi çalışmalar.
 
Üst