• DİKKAT

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

Mükerrer kayıtları silme

  • Konbuyu başlatan Konbuyu başlatan İhsan Tank
  • Başlangıç tarihi Başlangıç tarihi
İ

İhsan Tank

Misafir
BU MAKRONUN MÜKERRER KAYITLARINI İŞLEME ALMAK İSTEMİYORUM EK DOSYA GÖNDERİYORUM.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim HÜCRE As Range
Set s2 = Sheets("M1")
If Intersect(Target, [B1]) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
If IsDate(Target) Then
For Each HÜCRE In Range("B3:B" & Range("B65536").End(3).Row)
If Format(HÜCRE.Value, "m") = Format(Target, "m") And Year(HÜCRE.Value) = Year(Target) Then
Sat = s2.[b79].End(3).Row + 1
If Sat = 5 Then Sat = Sat + 1
s2.Cells(Sat, "b") = HÜCRE
s2.Cells(Sat, "e") = Cells(HÜCRE.Row, "c")
s2.Cells(Sat, "d") = Cells(HÜCRE.Row, "d")
s2.Cells(Sat, "f") = Cells(HÜCRE.Row, "f")
s2.Cells(Sat, "c") = Cells(HÜCRE.Row, "e")
s2.Cells(Sat, "g") = Cells(HÜCRE.Row, "g")
s2.Cells(Sat, "I") = Cells(HÜCRE.Row, "h")
End If
Next
MsgBox "İşlem tamam.", vbInformation
End If
Application.ScreenUpdating = True
End Sub
 

Ekli dosyalar

Mükerrer makro yazma

Selam arkadaşlar benim çalışma sayfamda otomatik bilgiler atılıyor ve bu atılan bilgiler aynı ( mükerrer ) ise yazmaması bunun için yardım bekliyorum
 
yaptım yalnız benim kine uygun bulamadım veya uyduramadım sizlerin yardımlarını bekliyorum bir de acizane bir istek daha bu makroyu nasıl yazıyorsunuz neye göre yazıyorsunuz
 
arkadaşlar İ1 sayfasını M1 sayfasına yukarıdaki makro ile birleştirdik. Şu an benim istediğim ise M1 Sayfasına atılan bilgileri sadece bir tane atması uzman arkadaşalrın yardımlarını bekliyorum
 
hocam bana yardım etmeyip bir deyardım istediğim konuyu kapatmanız sizce normal mi_?
 
Birşey birkez yazılır. Defalarca defalarca yazılmaz. Her on dakikada bir yardım yazıyorsunuz. Bunuda sizden başka kimsede yapmıyor.

.
 
hocam haklısınız ama ben tam 7 gündür sizden bir çalışma istedim ve hala cevap alamadım sizi üzmek istemem ama siz herkese yardım ediyorsunuz ve ben sizden yardım alamıyorum
 
cılgın86'lı' Alıntı:
hocam haklısınız ama ben tam 7 gündür sizden bir çalışma istedim ve hala cevap alamadım sizi üzmek istemem ama siz herkese yardım ediyorsunuz ve ben sizden yardım alamıyorum
Genişletmek için tıkla ...

yardım alamamanız sizin şahsınızla ilgili olmayabilir.
yeterince araştırma yapmadan illa sorumu yanıtlayın demiş gibi algılanmış olabilir.
sorunuzun cevabı uğraş ve sabır gerektiren bir çalışma olabilir.
konu anlaşılmamış olabilir.
konu birçok defa işlendiği halde aynı şeyleri soruyorsunuz olabilir.
sıklıkla aynı konuyu yeni konuymuş gibi açmanız bıkkınlık vermiş olabilir.
sıklıkla neden yardım etmiyorsunuz diye sitem etmeniz yardım etmek isteyenlere antipatik geliyor olabilir.
bir cevap verildiğinde, elimi kaptırsam kolumu kurtaramam endişesi duyuluyor olabilir.
...
...
...
 
syn cılgın86'lı,
siz açtığınız konuyu böyle mi takip ediyorsunuz!
konunuz kapatılmadı, açtığınız konular tarafımdan birleştirildi!
 
hocam ben size hak veriyorum ama ben bir hafta önce böyle bir soru sordum cevabı gelmedi bende parça parça cevap alarak şuan bu duruma getirdim şu an sizlerden sadece bir şey istiyorum oda sçalışma sayfasında ördüğünüz gibi İ1 sayfası M1 sayfasına makro ile bilgi atıyor yalnız ikinci defa aktif ettiğimde aynı verileri bir daha gönderiyor sadece bunu engelemenizi istedim ve fazlasıyla araştırma yaptım hatta olan sayfalar bu bilgisayarımda mevcut onlara bir taraftan bakıyorum
sizleri inşallah üzmemişimdir sizlerden yardım bekliyorum allah yardımcınız olsun.
 
uzmanamele' Alıntı:
syn cılgın86'lı,
siz açtığınız konuyu böyle mi takip ediyorsunuz!
konunuz kapatılmadı, açtığınız konular tarafımdan birleştirildi!
Genişletmek için tıkla ...

hocam benim diğer konum zaten yeni başlayanlardaydı siz ise makro-vba taşıdınız ve diğer konum ile birleştirdiniz bu gördüm daha sonra olan şeyden bahsediyordum ama ben unuttum sizlerde bana yardım ederseniz sevinirim çünkü ben tam bir haftadır uyuyamıyorum sırf bu çalışma yüzünden kafama çok takıyorum her halde ve sizde sıkıyorum son işlemime yardımcı olursanız sevinirim.
 
15 mesajin 10'u sizin tarafinizdan gonderilmis beyefendi.
bence oturup dusunun bunu, daha sonra "acaba neden cevap verilmemis?"in cevabini kendiniz de bulabilirsiniz.
bu benim kisisel gorusum tabi.
kolay gelsin.

mithat
 
Merhaba,
Sayın cılgın86'lı, biraz daha sabırlı olmamız lazım. Ben öğretmenim, bu nedenle bazı zamanlar oldukça meşgul oluyorum. Bu sıralar işte o bazı zamanlar... Malum sınav haftası, törenler vs...
Emin olun şimdi de pek vaktim yoktu; ama üst üste yazdığınız mesajları görünce dayanamadım.
Dosyanızdaki kodlamaya göre veri her değiştiğinde kodlar çalışacaktır. Bu aynı olsa da farklı olsa da değişmez. Ancak aynı veriyi aktarmasını engellemek için bazı tedbirler alabiliriz. Ben kodunuza aynı tarihli bir veri aktarmak istediğinizde size uyarı mesajı çıkmasını sağlayacak bir kaç satır ekledim. Bu mesaj çıktığında eveti seçerseniz veriler aynı da olsa aktarımı yapar; fakat hayır derseniz aktarımı gerçekleştirmeyecektir.
İsterseniz mesaj çıkmadan da engelleme yapabilirsiniz; ancak ben olan bitenden haberiniz olması açısından mesajlı uyarı ekledim.
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim HÜCRE As Range
    Set s2 = Sheets("M1")
    If Intersect(Target, [B1]) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    If IsDate(Target) Then
[COLOR="Red"]    For x = 5 To s2.[b78].End(3).Row
    If Format(Target, "m") = Format(s2.Cells(x, "b"), "m") And Year(Target) = Year(s2.Cells(x, "b")) Then
    Sor = MsgBox("Bu tarihi daha önce kaydetmişsiniz, yinede devam etmek istiyor musunuz.", vbYesNo)
    If Sor = vbNo Then Exit Sub
    End If: Next[/COLOR]
    For Each HÜCRE In Range("B3:B" & Range("B65536").End(3).Row)
    If Format(HÜCRE.Value, "m") = Format(Target, "m") And Year(HÜCRE.Value) = Year(Target) Then
           Sat = s2.[b78].End(3).Row + 1
           If Sat = 5 Then Sat = Sat + 1
            s2.Cells(Sat, "b") = HÜCRE
            s2.Cells(Sat, "e") = Cells(HÜCRE.Row, "c")
            s2.Cells(Sat, "d") = Cells(HÜCRE.Row, "d")
            s2.Cells(Sat, "f") = Cells(HÜCRE.Row, "f")
            s2.Cells(Sat, "c") = Cells(HÜCRE.Row, "e")
            s2.Cells(Sat, "g") = Cells(HÜCRE.Row, "g")
            s2.Cells(Sat, "I") = Cells(HÜCRE.Row, "h")
        End If
    Next
    MsgBox "İşlem tamam.", vbInformation
    End If
    Application.ScreenUpdating = True
End Sub
 

Ekli dosyalar

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