• DİKKAT

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

vba kodu ile hücreye otomatik açıklama ekleme mümkün mü

E

Etamustafa

Katılım
12 Kasım 2016
Mesajlar
131
Excel Vers. ve Dili
Excel 2016
Demek istedigim iki sayfa var mesai ve datamesai.
data mesai ye bilgi girişi yapıyoruz 1 tarih 2 sürücü ismi 3 atılan sefer 4 açıklama ;
Açıklama kısmına seferleri eksik atarsa nedenini yazıyoruz şu sebepten eksik atmıştır açıklamasını sonrada biz Mesai sayfasına giriyoruz ör/ 05.01.2018 mustafa kara sefer sayısı 8 buluyoruz datamesai yazıdıgımız bu açıklamayı orayada açıklama ekle diyerek aynı yazıyı kopyalıyoruz

Açıklamayı ilk yazdıgımız otomatikmen ön yüze otomatik olarak açıklama eklesin kendini.

Örnek dosya ekli Açıklamada yaptım mesaidata j58 açıklama yazdım
şimdiden teşekkür ederim ilginiz için.
 

Ekli dosyalar

Merhaba.

Begenizı açın, alt taraftan MESAİDATA sayfasının adına fareyle sağ tıklayın ve KOD GÖRÜNTÜLEyi seçin,
açılan VBA ekranında sağ taraftaki boş alana aşağıdaki kod'u yapıştırın.

MESAİDATA sayfası I sütunundaki hücrelere açıklama metni yazıp/silerek denemeler yapın.
.
Kod: 
[B]Private Sub Worksheet_Change(ByVal Target As Range)[/B]
alan = "I2:I" & Cells(Rows.Count, "A").End(3).Row
If Intersect(Target, Range(alan)) Is Nothing Then Exit Sub
Set wf = Application.WorksheetFunction
Set m = Sheets("MESAİ"): Set md = Sheets("MESAİDATA")
If wf.CountIf(m.[C:C], md.Cells(Target.Row, "B")) = 0 Or _
    wf.CountIf(m.[3:3], md.Cells(Target.Row, "A")) = 0 Then Exit Sub
        sat = wf.Match(md.Cells(Target.Row, "B"), m.[C:C], 0) + 2
        sut = wf.Match(md.Cells(Target.Row, "A"), m.[3:3], 0)
With m.Cells(sat, sut)
    .ClearComments
    If Target <> "" Then
        .AddComment: .Comment.Text Text:=Target.Text
    End If
End With
[B]End Sub[/B]
 
Hocam ilginiz için teşekkür ederim, Şu aşagıdaki neden dir bilmem arasıra hata veriyor ama kaynagı nedir bilmiyorum ondan sonra iptal tekrar reset atıyorum sonra devam ediyor.
Onun haricinde çok iyi bir şekilde çalışıyor.

.AddComment: .Comment.Text Text:=Target.Text

ilginiz yardımlarınız için teşekkür ederim....
 
Tekrar merhaba.

Önceki kod cevabımda düzeltme yaptım (mavi renklendirdiğim satır)
sayfayı yenileyerek kontrol edersiniz.
.
 
HOCAM TAM OLARAK SORUNU ANLADIM; tarih yazıyorum ok! isim yazıyorum ok! sefer yazıyorum SORUN! mesala örnek vermek isterim.:
tarih :14.01.2018 isim: Mehmet Kaya sefer:10 diye yazdıgım zaman
14.01.2018 önce 10 sefer varsa açıklayı oraya koyuyor aYnı seferler mevcut olabilir dahA önce böyle bir sefer sayısı varsa tarihi baz almadan o servis sayısına açıklama koyuyor Ömer hocam
 
Son düzenleme:
TAm olarak bu kod ama isim ve tarih baz alırsa çok iyi olur yardımcı olursanız sevinirim.
 
Tekrar merhaba.

Önceki cevabımdaki kod'u günceledim.

Kod'un yeni halinin çalışma mantığı şöyle;
-- MESAİDATA sayfası B sütunundaki ad soyad MESAİ sayfası C sütununda yoksa veya
MESAİDATA sayfası A sütunundaki tarih MESAİ sayfası 3'üncü satırında yoksa İŞLEM YAPMA,
-- Ad soyad ve tarihin her ikisi de varsa;
... I sütunu doluysa ismin satırından 2 satır sonrasına, tarihin bulunduğu sütuna açıklama EKLE,
... I sütunu boşsa varolan açıklamayı SİL.

Sayfayı yenileyerek önceki kod cevabımı kontrol ediniz.
.
 
Yardım Rica Ediyorum.

Ömer BARAN' Alıntı:
Tekrar merhaba.

Önceki cevabımdaki kod'u günceledim.

Kod'un yeni halinin çalışma mantığı şöyle;
-- MESAİDATA sayfası B sütunundaki ad soyad MESAİ sayfası C sütununda yoksa veya
MESAİDATA sayfası A sütunundaki tarih MESAİ sayfası 3'üncü satırında yoksa İŞLEM YAPMA,
-- Ad soyad ve tarihin her ikisi de varsa;
... I sütunu doluysa ismin satırından 2 satır sonrasına, tarihin bulunduğu sütuna açıklama EKLE,
... I sütunu boşsa varolan açıklamayı SİL.

Sayfayı yenileyerek önceki kod cevabımı kontrol ediniz.
.
Genişletmek için tıkla ...



Merhaba Hocam,
Yukarıda yapmış olduğunuz kodu benim bir çalışmamda kullanmak istiyorum. Ancak, Benim yapmak istediğim hücre içerisinde yazılı olan ismin "TABLO" sayfası "H" kolonunda bulunan adresi Açıklamaya getirmesini istiyorum. "TABLO" sayfasında bilgi yoksa "LİSTE" sayfasına Açıklama eklemesin. Yardımcı olabilir misiniz? Teşekkür ederim.
 
Dosyanızda gerçek kişisel bilgilerin olduğunu düşündüğüm için Ömer beyin uyarısı ile kaldırdım.

Lütfen kimlik numaraları yerine sanal numaralar yazarak dosyanızı foruma ekleyiniz.
 
Merhaba.

Sayın AYHAN sağ olsun.

Gerçek veriler olduğunu düşündüğüm (bazı kontroller yaptım elbette) özel bilgiler içeren dosyanın kaldırılması yerinde oldu.

Zira belgede TC Kimlik Numaraları/Ad Soyad/adres/telefon vs gibi bilgiler mevcut idi.
.
 
Yardım Rica Ediyorum.

Merhaba Ömer Hocam, Hassasiyetiniz için çok teşekkür ediyorum. Liste üzerinde bulunan satırları kaldırmadan yollamışım. Özür diliyorum. Daha dikkatli olacağım.

Yukarıda yapmış olduğunuz kodu benim bir çalışmamda kullanmak istiyorum. Ancak, Benim yapmak istediğim hücre içerisinde yazılı olan ismin "TABLO" sayfası "H" kolonunda bulunan adresi Açıklamaya getirmesini istiyorum. "TABLO" sayfasında bilgi yoksa "LİSTE" sayfasına Açıklama eklemesin.

Yardımcı olabilir misiniz? Teşekkür ederim.
 

Ekli dosyalar

muhammethezer' Alıntı:
Merhaba Ömer Hocam, Hassasiyetiniz için çok teşekkür ediyorum. Liste üzerinde bulunan satırları kaldırmadan yollamışım. Özür diliyorum. Daha dikkatli olacağım.

Yukarıda yapmış olduğunuz kodu benim bir çalışmamda kullanmak istiyorum. Ancak, Benim yapmak istediğim hücre içerisinde yazılı olan ismin "TABLO" sayfası "H" kolonunda bulunan adresi Açıklamaya getirmesini istiyorum. "TABLO" sayfasında bilgi yoksa "LİSTE" sayfasına Açıklama eklemesin.

Yardımcı olabilir misiniz? Teşekkür ederim.
Genişletmek için tıkla ...

Yardımcı olabilir misiniz? Teşekkür ederim.
 
Deneyiniz.

Kod: 
Sub Açıklama_Ekle()
    Dim S1 As Worksheet, S2 As Worksheet, Veri As Range
    
    Set S1 = Sheets("LİSTE")
    Set S2 = Sheets("TABLO")
    
    For Each Veri In S1.Range("B6:AF35")
        On Error Resume Next
        Veri.Comment.Delete
        On Error GoTo 0
        If Veri.Value <> "-----" Then
            If Veri.Value <> "" Then
                Set Bul = S2.Range("E:E").Find(Veri.Value, , , xlWhole)
                If Not Bul Is Nothing Then
                    Veri.AddComment Bul.Offset(0, 3).Value
                    Veri.Comment.Visible = False
                End If
            End If
        End If
    Next

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
Korhan Ayhan' Alıntı:
Deneyiniz.

Kod: 
Sub Açıklama_Ekle()
    Dim S1 As Worksheet, S2 As Worksheet, Veri As Range
    
    Set S1 = Sheets("LİSTE")
    Set S2 = Sheets("TABLO")
    
    For Each Veri In S1.Range("B6:AF35")
        On Error Resume Next
        Veri.Comment.Delete
        On Error GoTo 0
        If Veri.Value <> "-----" Then
            If Veri.Value <> "" Then
                Set Bul = S2.Range("E:E").Find(Veri.Value, , , xlWhole)
                If Not Bul Is Nothing Then
                    Veri.AddComment Bul.Offset(0, 3).Value
                    Veri.Comment.Visible = False
                End If
            End If
        End If
    Next

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
Genişletmek için tıkla ...


Korhan Ayhan Hocam,
Cevabınız için teşekkür ediyorum. Sayfaya Modül ekledim ve kodu çalıştırdım. Ancak, TABLO sayfasındaki E:E satırında bulunan ilk isme karşılık, LISTE sayfası B6 hücresindeki ilk isme getiriyor ve sonrasında "Veri.AddComment Bul.Offset(0, 3).Value" satırında hata uyarısı veriyor.

Bir de şu şekilde olabilir mi?
Örnek olarak;
20.Nisan kolunda 13.30-14.00 saatleri arasında 30 dakikalık kısımda bulunan kişilere
ait hücrelerin otomatik tek bir renk alması ve TABLO sayfası H:H kolonunda karşılık gelen hücredeki bilginin açıklama olarak gelmesini sağlayabilir misiniz?
 

Ekli dosyalar

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