• DİKKAT

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

Acil işler raporu

O

OKUROGLU3375

Katılım
29 Eylül 2017
Mesajlar
110
Excel Vers. ve Dili
professional_plus_2016 Türkçe
Selamlar; Acil İşler seçeneği konusunda tik yoluyla kopyalama ve kaldırma konusunda yardımlarınıza ihtiyacım var. Bu konuda yardımcı olabilirseniz sevinirim. Örnek ekli dosya linki bulunmaktadır. Dosya içerisinde ayrıntılı olarak istenilen anlatılmıştır. Yardımlarınız için teşekkürler... OKUROGLU

http://www.dosya.tc/server10/sei8fh/ACIL_RAPORU_ORNEK.zip.html
 
Merhaba,
Gördüğüm kadarıyla 7 adet CheckBox nesnesi var. Aşağıda CheckBox1_Change olayı için gerekli kodları hazırladım. Aynı kodu kopyalayarak sadece kırmızı ile işaretlediğim yeri CheckBox numarasına uygun şekilde her CheckBox un Change olayına ekleyiniz.
Kod: 
Private Sub [COLOR="Red"][B]CheckBox1[/B][/COLOR]_Change()
Dim sh As Worksheet, ss As Long, cb As OLEObject, alan As Range, ara As Range, k As Range
Set sh = Sheets("ANASAYFA")
ss = sh.Range("A" & Rows.Count).End(3).Row
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
For Each cb In sh.OLEObjects
    If TypeOf cb.Object Is MSForms.CheckBox Then
    If cb.Name = "[COLOR="Red"][B]CheckBox1[/B][/COLOR]" Then
        i = cb.Index
        sat = i + 3
            Set alan = sh.Range("A" & sat & ":AC" & sat)
            son = Sheets("RAPOR").Range("A" & Rows.Count).End(3).Row + 1
            Set ara = Sheets("RAPOR").Range("C4:C" & son)
            aranan = sh.Range("C" & sat)
        If cb.Object.Value = True Then
            alan.Interior.ColorIndex = 6
            Sheets("RAPOR").Range("A" & son & ":AC" & son).Value = alan.Value
        Else
            alan.Interior.ColorIndex = xlNone
            Set k = ara.Find(aranan, , xlValues, xlWhole)
            If Not k Is Nothing Then
            On Error Resume Next
                adr = k.Address
                Do
                Sheets("RAPOR").Range("A" & k.Row & ":AC" & k.Row).ClearContents
                Set k = ara.FindNext(k)
                Loop While Not k Is Nothing And adr <> k.Address
            End If
        End If
    End If
    End If
Next cb
Application.EnableEvents = True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
 
Sayın okuroğlu Bir dosya hazırladım renklendirmelerle uğraşmadım sadece tık koyduğun satırları rapor sayfasına taşıyan, tıkı kaldırınca rapor sayfasından silen bir dosya.

Senin koyduğun CheckBox nesnesini düzenlemeyi bilmediğimden AK hücrelerine veri doğrulama ekledim. onları dene.

Bir de çok uzun dosyalarda bu nesneleri eklemek uzun sürüyor. Bunun yerine benim dosyamda kopyalayacağın satırda AH hücresine 1 yazarsan (veya RAPORLAR! E1 Hücresindeki değere göre aldığından oraya yazacağın bir işarette olabilir) aynı işi yapabilirsin. kolay gelsin

http://s5.dosya.tc/server5/vb0ksb/ACIL_RAPORU_ORNEK.rar.html
 
Ellerinize sağlık...

Ellerinize sağlık kopyalama işlemleri olmuş... fakat ekli örnektede görüleceği gibi rapor dosyasındaki satırlar silinmiyor...
Ayrıca esas çalışma dosyamda tik olayı yaklaşık 800-900 kalemden oluşuyor, Türkiyenin ileri gelen fabrikalarından birinde görev alıyorum... İşler yoğun haliyle, yapılacak işlerde çok oluyor, Mantıkan 800-900 tane tik yapmam mı daha iyi olur yoksa başka seçeneklerde olabilirmi? Kolaylaştırmak açısından. ( Tik yanındaki bir hücreye "ACİL" yazsak formülasyonla eğer hücre içinde acil var ise satırı rapora kopyala... "ACİL" silinirse yada kaldırılırsa Rapordan satırı sil gibi mesela... Mantığı anlatmaya çalıştım. Umarım yanlış birşey yapmamışımdır. Teşekkür ederim yardımlarınıza...
http://s8.dosya.tc/server5/i0b52l/ACIL_RAPORU_ORNEK.zip.html
 
Hüseyin bey teşekkürler sizin dediğinizde olur, tek bir ricam kopyalar iken formülleriyle kopyalıyor.. Müdürlüğe gönderirken "RAPOR" Dosyasını bağımsız yapıp tek bir dosya göndermem gerek, kopyalar iken formülleriyle kopyalamaz ise böyle bir seçenek var ise sevinirim... Uğraşlarınıza ve çabalarınıza teşekkür ederim... OKUROGLU
 
Benim yukarıda gönderdiğim dosya ile sizi gönderdiğiniz aynı değil. Benim personel sayfasında ak hücrelerindeki onayları kaldırınca rapor sayfası siliniyor. Dediğinizden bir şey anlamadım. 800 satırlık bir dosyaya onay kutusu ekleyip hücrelerle ilişkilendirmek uzun zaman alır. Mesela bir makroyla AH sütunundaki hücrelere çift tıklayınca 1 veya ne ise yazdırılır. satır kopyalanır. 1 'i silince de silinir. Tik koyup kaldırmak gibi.
 
Hüseyin bey; o dosyayı ben Antonio bey'e göndermiştim. Onun yazmış olduğu makroya nazaran. Ben sizin gönderdiğiniz dosyayıda inledim. Tamam bu dosyada olur, tek ricam kopyalar iken "RAPOR" dosyasına formülleride atmasın demek istemiştim... :))) Teşekkürler
 
O zaman ANTONİO üstadın önerdiği makroyu denemelisiniz bence. 5 nolu mesajınızda belirttiğiniz hususu "Müdürlüğe gönderirken "RAPOR" Dosyasını bağımsız yapma" belki gerçekleştirir. Eğer bir çözüm bulamazsanız:

Raporu oluşturduktan sonra Benim hazırladığım dosyanın rapor sayfası A:AC aralığını seçin kopyalayın, Rapor sayfasının aynısını bağımsız bir dosya haline getirip sağ klik yapıştır, 123 (Özel yapıştır değerleri) yaparsanız istediğiniz olur. Saygılarımla.
 
Merhaba.

Ben yardımcı sütun (boş olan AH sütununu düşündüm) kulanarak çözüm önerisinde bulunmak istiyorum.
İsterseniz; hazırlık aşamasını tamamladıktan sonra AH sütununu her iki sayfada da gizleyebilirsiniz.

► HAZIRLIK:
-- Önce belgenizde bulunan CheckBox'ların tümünü silin,
-- ANASAYFA isimli sayfanın AH sütununa 1'den başlayarak sıra numarası verin (belirleyici olan bu numaradır),
-- RAPOR sayfasındaki tablonun başlık satırında AD3 hücresine 0 yazın,
-- Alt taraftan ANASAYFA isimli sayfanın 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 kodu yapıştırın.

► KOD'UN ÇALIŞMASI:
-- ANASAYFA isimli sayfadaki AI sütunundaki hücreye FAREYLE ÇİFT TIKLAYIN.
1) Çift tıklanan hücrenin bulunduğu satır, formülsüz olarak RAPOR sayfasına kopyalanır,
2) Kopyalamanın yapıldığının anlaşılmasını ve KODUN çalışmasını sağlamak üzere çift tıkladığınız hücreye "K" harfi yazılır,
3) satır SARI zemin rengiyle boyanır.

-- ANASAYFA isimli sayfada "K" yazılı (daha önce kopyalanmış anlamında) AI sütunu hücresine FAREYLE ÇİFT TIKLAYIN.
1) zemin rengi kaldırılır,
2) daha önce kodun yazdığı "K" silinir,
3) RAPOR sayfasındaki ilgili satır silinir.
.
Kod: 
[B]Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)[/B]
Set r = Sheets("RAPOR")
If Intersect(Target, Range("AI4:AI" & Cells(Rows.Count, 1).End(3).Row)) Is Nothing Then Exit Sub

Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
ActiveSheet.Unprotect "[B][COLOR="Blue"][SIZE="4"]123[/SIZE][/COLOR][/B]"
If Target = "K" Then
    sat = WorksheetFunction.Match(Cells(Target.Row, "AH"), r.[[B][COLOR="Red"][SIZE="4"]AD[/SIZE][/COLOR][/B]:[B][COLOR="Red"][SIZE="4"]AD[/SIZE][/COLOR][/B]], 0)
        r.Range("A" & sat & ":[B][COLOR="Red"][SIZE="4"]AD[/SIZE][/COLOR][/B]" & sat).Delete Shift:=xlUp
        Range("A" & Target.Row & ":AC" & Target.Row).Interior.Color = xlNone
        Range("AI" & Target.Row).Interior.Color = xlNone
    Target = "": Cancel = True
    ActiveSheet.Protect "[B][COLOR="Blue"][SIZE="4"]123[/SIZE][/COLOR][/B]": Exit Sub
End If

If Target = "" Then
    If WorksheetFunction.Match(Cells(Target.Row, "AH"), r.[[B][COLOR="Red"][SIZE="4"]AD[/SIZE][/COLOR][/B]:[B][COLOR="Red"][SIZE="4"]AD[/SIZE][/COLOR][/B]], 1) - 1 = 2 Then
        sat = 4
    Else
        sat = WorksheetFunction.Match(Cells(Target.Row, "AH"), r.[[B][COLOR="Red"][SIZE="4"]AD[/SIZE][/COLOR][/B]:[B][COLOR="Red"][SIZE="4"]AD[/SIZE][/COLOR][/B]], 1) + 1
    End If
        r.Range("A" & sat & ":[B][COLOR="Red"][SIZE="4"]AD[/SIZE][/COLOR][/B]" & sat).Insert Shift:=xlDown
            Range("A" & Target.Row & ":AC" & Target.Row).Copy
                r.Range("A" & sat).PasteSpecial Paste:=xlPasteFormats
                r.Range("A" & sat).PasteSpecial Paste:=xlPasteValues
                r.Cells(sat, "[B][COLOR="Red"][SIZE="4"]AD[/SIZE][/COLOR][/B]") = Cells(Target.Row, "AH")
            Application.CutCopyMode = False
        Range("A" & Target.Row & ":AC" & Target.Row).Interior.Color = vbYellow
        Range("AI" & Target.Row).Interior.Color = vbYellow
    Target = "K": Sheets("ANASAYFA").Activate: Cancel = True
    ActiveSheet.Protect "[B][COLOR="Blue"][SIZE="4"]123[/SIZE][/COLOR][/B]": Exit Sub
End If
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
[B]End Sub[/B]
 
huseyinvurkan' Alıntı:
........ 800 satırlık bir dosyaya onay kutusu ekleyip hücrelerle ilişkilendirmek uzun zaman alır....
Genişletmek için tıkla ...
Orijinal dosyanızın boyutu bahsettiğiniz gibiyse, baştan beri hiç checkbox tercih etmemeliydiniz. Sayın Ömer BARAN'ın önerisini dikkate almanızı tavsiye ederim.
 
Selamlar; ÖMER BEY
AD ve AG sütunları arası formüllerin yanlışlıkla silinmemesi için korumaya alınmıştır.
Korumalı kalması için Sayfada protek vardır. Protekli iken göndermiş olduğunuz makro hata vermektedir.
Proteksiz iken çok güzel çalışmaktadır. "ELLERİNİZE SAĞLIK"

Şunları yapmamız olanaklımıdır.
1- Sayfa formüller nedeniyle korumalıyken makro çalıştırılabilir mi?
2- Korumalı iken çalıştırılabiliyor ise, A'dan AC'ye kadar kopyalaması mümkün mü?
3- Çift tıkladığımızda sarıya boyanan zeminin A'dan AC'ye ve AI sütununu boyaması mümkün mü?
4- AD-AG arası sütunların çift tıkladığımızda "sarıya" boyanmaması lazım...

" ELLERİNİZE VE YÜREĞİNİZE SAĞLIK"
 
Selamlar; ÖMER BEY
AD ve AG sütunları arası formüllerin yanlışlıkla silinmemesi için korumaya alınmıştır.
Korumalı kalması için Sayfada protek vardır. Protekli iken göndermiş olduğunuz makro hata vermektedir.
Proteksiz iken çok güzel çalışmaktadır. "ELLERİNİZE SAĞLIK"

Şunları yapmamız olanaklımıdır.
1- Sayfa formüller nedeniyle korumalıyken makro çalıştırılabilir mi?
2- Korumalı iken çalıştırılabiliyor ise, A'dan AC'ye kadar kopyalaması mümkün mü?
3- Çift tıkladığımızda sarıya boyanan zeminin A'dan AC'ye ve AI sütununu boyaması mümkün mü?
4- AD-AG arası sütunların çift tıkladığımızda "sarıya" boyanmaması lazım...

" ELLERİNİZE VE YÜREĞİNİZE SAĞLIK"
 
Merhaba.

Önceki cevabımı güncelledim.

Önce; RAPOR sayfasındaki AD:AG sütunlarını silin.
RAPOR sayfasında 0 yazılacak BAŞLIK hücresi AD3 oldu.

Kod'daki kırmızı renklendirdiğim sütun adları değişti.
Kod'da mavi renklendirdiğim 123 sayıları (3 adet var), sayfa koruma şifresidir,
bunun yerine kendi kullandığınız şifreyi (yine çift tırnak arasında) yazacaksınız.

İşlem için önce koruma kaldırılıyor, işlem yapılıyor ve tekrar sayfa koruması uygulanıyor.
Bu nedenle kodun çalışmasında bir yavaşlama olabilir doğal olarak.

Önceki cevabımı, sayfayı yenileyerek kontrol edin.
.
 
Ömer bey; Uygulamalarını yaptım ve tam istediğim gibi oldu. Saygılarımı sunarak çok büyük teşekkürlerimi sunuyorum. İnanın büyük yardımcı oldunuz bana.... O değerli vakitlerinizi ayırdığınız için bütün emeği geçenlere "TEŞEKKÜR" ediyorum... Okuroglu
 
OKUROGLU3375' Alıntı:
Ömer bey; Uygulamalarını yaptım ve tam istediğim gibi oldu. Saygılarımı sunarak çok büyük teşekkürlerimi sunuyorum. İnanın büyük yardımcı oldunuz bana.... O değerli vakitlerinizi ayırdığınız için bütün emeği geçenlere "TEŞEKKÜR" ediyorum... Okuroglu
Genişletmek için tıkla ...
İhtiyaç karşılandığına göre mesele yok.

İyi çalışmalar dilerim.
.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst