- Katılım
- 8 Mart 2019
- Mesajlar
- 73
- Excel Vers. ve Dili
- Excel 2013 64 Bit
- Altın Üyelik Bitiş Tarihi
- 24-06-2024
Mantığını anlasam düzelterim de çözmeye çalışıyorum halen.Üstteki mesajımdaki kodu ve dosyayı güncelledim. Tekrar deneyiniz.
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Mantığını anlasam düzelterim de çözmeye çalışıyorum halen.Üstteki mesajımdaki kodu ve dosyayı güncelledim. Tekrar deneyiniz.
kullandığım internette filtre var o yüzden yükleme yapamıyorum.Merhaba.
Sayın AYHAN şu an çevrimiçi değil.
Sanıyorum verilen kodları gerçek belgenize uyarlarken sorun yaşıyorsunuz.
Bu tür sorunla karşılaşmamak için sorularınızı, gerçek belgenizle aynı yapıda örnek belge üzerinden sormanız yerinde olur.
Örnek belge özellikleri ve örnek belge yükleme yöntemine ilişkin kısa açıklama cevabımın altındaki İMZA bölümünde var.
Hücre adresleri, kodlarda farklı şekilllerde kullanıllabilir.
-- Range("A" & 10) şeklinre yazıldığında A sütun adı, 10 satır numarası >> yani A10 hücresi,
-- Cells(7,"A") şeklinde yazılmışsa, ilk sayı satır numarası, ikinci kısımdaki A sütun adı >> yani A7 hücresi,
-- Cells(3, 8) şeklinde yazılmışsa 3 satır numarası, 8 sütun numarası >> G3 hücresi
anlamına gelir.
.
Mail adresiniz var mail atabilirim örnek şablonuma göre bir form düzenleyip atabilirimMerhaba.
Sayın AYHAN şu an çevrimiçi değil.
Sanıyorum verilen kodları gerçek belgenize uyarlarken sorun yaşıyorsunuz.
Bu tür sorunla karşılaşmamak için sorularınızı, gerçek belgenizle aynı yapıda örnek belge üzerinden sormanız yerinde olur.
Örnek belge özellikleri ve örnek belge yükleme yöntemine ilişkin kısa açıklama cevabımın altındaki İMZA bölümünde var.
Hücre adresleri, kodlarda farklı şekilllerde kullanıllabilir.
-- Range("A" & 10) şeklinre yazıldığında A sütun adı, 10 satır numarası >> yani A10 hücresi,
-- Cells(7,"A") şeklinde yazılmışsa, ilk sayı satır numarası, ikinci kısımdaki A sütun adı >> yani A7 hücresi,
-- Cells(3, 8) şeklinde yazılmışsa 3 satır numarası, 8 sütun numarası >> G3 hücresi
anlamına gelir.
.
Anladım Hocam kusura bakmayın sadece önemli bir konu işi yetiştirmem lazım sürem daralıyor. O yüzden bu acelemYazdığım cevabı, başından sonuna dikkatli bir şekilde okumamışsınız anlaşılan.
E-posta adresini veren, makro ile çözüm önerisinde bulunan ben değilim Sayın Korhan AYHAN.
Ben sadece, Sayın AYHAN'ın verdiği çözümü gerçek belgenize uyarlarken karşılaşacağınız muhtemel sıkıntıyı
halledebilmeniz için hücre adreslerinin makrolarda kullanılan yazım biçimleri konusunda örnekler verdim.
Benim yazdığım açıklamaları dikkate alarak, Sayın Korhan AYHAN'ın verdiği çözüm cevabındaki makro kodlarını kendi belgenize
uyarlayabileceğinizi düşünüyorum.
.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Veri As Range, Baglanti As Object, Kayit As Object, Dizi As Variant
Set Baglanti = CreateObject("AdoDb.Connection")
Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;" & _
"Data Source = " & ThisWorkbook.FullName & ";" & _
"Extended Properties=""Excel 12.0;Hdr=No"""
If Target.Cells.Count > 1 Then
For Each Veri In Selection
If Cells(Veri.Row, "H") = "" Then
Range("I" & Veri.Row).Validation.Delete
Range("I" & Veri.Row).Value = ""
Range("J" & Veri.Row).Validation.Delete
Range("J" & Veri.Row).Value = ""
End If
Next
End If
Select Case Target.Column
Case 8
Set Kayit = Baglanti.Execute("Select F2 From [Şube$] Where F1 = '" & Cells(Target.Row, "H") & "' Group By F2")
If Not Kayit.EOF Then
Dizi = Application.Transpose(Application.Transpose(Kayit.GetRows))
With Range("I" & Target.Row)
.Validation.Delete
.Validation.Add Type:=xlValidateList, Formula1:=Join(Dizi, ",")
End With
End If
Case 9
Set Kayit = Baglanti.Execute("Select F3 From [Şube$] Where F1 = '" & Cells(Target.Row, "H") & "' And F2 = '" & Cells(Target.Row, "I") & "' Group By F3")
If Not Kayit.EOF Then
Dizi = Application.Transpose(Application.Transpose(Kayit.GetRows))
With Range("J" & Target.Row)
.Validation.Delete
.Validation.Add Type:=xlValidateList, Formula1:=Join(Dizi, ",")
End With
End If
End Select
Set Kayit = Nothing
Set Baglanti = Nothing
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Veri As Range, Baglanti As Object, Kayit As Object, Dizi As Variant
If Intersect(Target, Range("H2:H" & Rows.Count)) Is Nothing Then Exit Sub
If Target.Cells.Count > 1 Then
For Each Veri In Selection
If Cells(Veri.Row, "H") = "" Then
Range("I" & Veri.Row).Validation.Delete
Range("I" & Veri.Row).Value = ""
Range("J" & Veri.Row).Validation.Delete
Range("J" & Veri.Row).Value = ""
End If
Next
End If
Set Baglanti = CreateObject("AdoDb.Connection")
Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;" & _
"Data Source = " & ThisWorkbook.FullName & ";" & _
"Extended Properties=""Excel 12.0;Hdr=No"""
Set Kayit = Baglanti.Execute("Select Distinct F1 From [Şube$A3:A65536] Order By F1 Asc")
If Not Kayit.EOF Then
Dizi = Application.Transpose(Application.Transpose(Kayit.GetRows))
With Range("H" & Target.Row)
.Validation.Delete
.Validation.Add Type:=xlValidateList, Formula1:=Join(Dizi, ",")
End With
End If
Set Kayit = Nothing
Set Baglanti = Nothing
End Sub
teşekkür ederim. Sorunum çözüldü. Bununla alakalı olarak kodlama kısmında hangi satılarda değişiklik yaparsam hücre değişkliği yapabilirim. Yukarıda belirttiğiniz kodlama farklı bir hücreye atamak istersem hangi harfleri değiştirmem gerek. Öğrenmek amacıyla soruyorumDeneyiniz.
Kod:Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim Veri As Range, Baglanti As Object, Kayit As Object, Dizi As Variant Set Baglanti = CreateObject("AdoDb.Connection") Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;" & _ "Data Source = " & ThisWorkbook.FullName & ";" & _ "Extended Properties=""Excel 12.0;Hdr=No""" If Target.Cells.Count > 1 Then For Each Veri In Selection If Cells(Veri.Row, "H") = "" Then Range("I" & Veri.Row).Validation.Delete Range("I" & Veri.Row).Value = "" Range("J" & Veri.Row).Validation.Delete Range("J" & Veri.Row).Value = "" End If Next End If Select Case Target.Column Case 8 Set Kayit = Baglanti.Execute("Select F2 From [Şube$] Where F1 = '" & Cells(Target.Row, "H") & "' Group By F2") If Not Kayit.EOF Then Dizi = Application.Transpose(Application.Transpose(Kayit.GetRows)) With Range("I" & Target.Row) .Validation.Delete .Validation.Add Type:=xlValidateList, Formula1:=Join(Dizi, ",") End With End If Case 9 Set Kayit = Baglanti.Execute("Select F3 From [Şube$] Where F1 = '" & Cells(Target.Row, "H") & "' And F2 = '" & Cells(Target.Row, "I") & "' Group By F3") If Not Kayit.EOF Then Dizi = Application.Transpose(Application.Transpose(Kayit.GetRows)) With Range("J" & Target.Row) .Validation.Delete .Validation.Add Type:=xlValidateList, Formula1:=Join(Dizi, ",") End With End If End Select Set Kayit = Nothing Set Baglanti = Nothing End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim Veri As Range, Baglanti As Object, Kayit As Object, Dizi As Variant If Intersect(Target, Range("H2:H" & Rows.Count)) Is Nothing Then Exit Sub If Target.Cells.Count > 1 Then For Each Veri In Selection If Cells(Veri.Row, "H") = "" Then Range("I" & Veri.Row).Validation.Delete Range("I" & Veri.Row).Value = "" Range("J" & Veri.Row).Validation.Delete Range("J" & Veri.Row).Value = "" End If Next End If Set Baglanti = CreateObject("AdoDb.Connection") Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;" & _ "Data Source = " & ThisWorkbook.FullName & ";" & _ "Extended Properties=""Excel 12.0;Hdr=No""" Set Kayit = Baglanti.Execute("Select Distinct F1 From [Şube$A3:A65536] Order By F1 Asc") If Not Kayit.EOF Then Dizi = Application.Transpose(Application.Transpose(Kayit.GetRows)) With Range("H" & Target.Row) .Validation.Delete .Validation.Add Type:=xlValidateList, Formula1:=Join(Dizi, ",") End With End If Set Kayit = Nothing Set Baglanti = Nothing End Sub
For Each Veri In Selection
If Cells(Veri.Row, "H") = "" Then
Range("I" & Veri.Row).Validation.Delete
Range("I" & Veri.Row).Value = ""
Range("J" & Veri.Row).Validation.Delete
Range("J" & Veri.Row).Value = ""
End If
Next
Case 8 (H sütunu)
Case 9 (I sütunu)
Hocam kodu kopyaladım farklı kaydetten makro içerebilen Excel çalışma kitabı şeklinde kaydediyorum. Daha sonra işlem yapıp kaydedip kapatıp tekrar açın ekte gönderdiğim resimlerdeki hatayı veriyor sebebi neden olabilirKodun aşağıdaki bölümünde eğer çoklu hücre seçip delete tuşuna basarsanız ve bu alanda "H" sütununa denk gelen hücre varsa, "I" ve "J" sütunundaki doğrulama ve hücre içeriklerinin silinmesi sağlanıyor.
Koddaki aşağıdaki satırlar ise doğrulama sütunlarını ifade etmektedir.Kod:For Each Veri In Selection If Cells(Veri.Row, "H") = "" Then Range("I" & Veri.Row).Validation.Delete Range("I" & Veri.Row).Value = "" Range("J" & Veri.Row).Validation.Delete Range("J" & Veri.Row).Value = "" End If Next
Kod:Case 8 (H sütunu) Case 9 (I sütunu)
Günaydın Hocam farklı kaydederken "Dikkat Belgenizin bazı bölümleri, Belge Denetçisi tarafından kaldırılamayan kişisel bilgiler içerebilir" hatası veriyorOfiste Excel 2010 var. Sorunsuz çalışıyor. Dosyanızı görmek lazım.
aynı formülü office 2007'de de denedim aynı hatayla karşılaşmaktayımBu arada office 2013 kullanıyorum. Sürümden kaynaklı olabilir mi?
Hocam linkte belirtileni yaptım. Makrolar, Formlar ve activex dentimlerinde hata verdi. Daha fazla bilgi olan kısma tıklayıp beni https://support.office.com/tr-tr/article/makroları-veya-vba-kodu-bulunamadı-5e836a6e-cce5-494a-b0b8-2ce739d35f2f?ui=tr-TR&rs=tr-TR&ad=TR buraya yönlendirdi ama orada herhangi bir makro gözükmediği için silemiyorum. daha sonra şu işlemi "Makrolar VBA Düzenleyicisi'nde bulmak için Alt + F11 tuşlarına basın " yapınca sizin kod yazdığınız ekrana atıyor.