Excel Forum
ALTIN ÜYELİK Hakkında Bilgi


Geri Git   Excel Forum > EXCEL-Soruları > Makro-VBA
Atatürk
Şifremi Unuttum

DUYURU SİSTEMİ / REKLAM PANOSU

Makro-VBA Makro veya VBA ile ilgili sorularınızı buraya gönderebilirsiniz.
Dosya ekleyebilirsiniz

Özel Arama


Yanıtla
 
Paylaş Konu Araçları Görünüm Modları
Eski 06-02-2018, 21:56   #1
sahika51
Altın Üye
 
Giriş: 28/10/2006
Mesaj: 42
Excel Vers. ve Dili:
2003
Varsayılan Hücredeki sayıyı ayrıştırma

Ustalar hayırlı günler, ekte verdiğim örnek dosyada her kişinin c5 hücresinde haftalık girdiği ders sayısı var. biz bunları maaş ve ücrete otomatik dağıtmak istiyoruz.
1- C5 Teki rakam 15 in üstünde veya eşitse, 15 i e5-ı5 arasına dağıtsın. Ancak
2- arkadaşın gelmediği gün veya olmadığı günü ben sildiğim de (Bu herhangi bir gün olabilir) yani e5 ve ı5 arasındaki değerlerden birini veya bir kaçını sildiğim de 15 kalan gün sayısına dağıtılsın.
3- c5 15 in altında ise kurallar e5 ı5 arası için aynı.
4- c5 teki değer 15 e eşit veya yüksekse e6-ı6 hücrelerine c5 teki rakamdan e5-ı5 hücrelerine dağıttığımız rakamların toplamından çıkarıp kalan değeri yaymak istiyoruz. Ancak
5- e5-ı5 arasında hangi günü veya günleri silmiş isek otomatik olarak e6-ı6 arasına denk gelen gün veya günler silinmeli. Kalan sayı 15 ten yukarıda ise diğer günlere dağıtılmalı.

Bunu makro olarak yazılabilirmi?
Şimdiden teşekkür ederim.
Eklenmiş Dosyalar
Dosya Türü: xlsx RAKAMLARI HÜCRELERE.xlsx (11.7 KB, 15 Görüntülenme)

Bu mesaj en son " 06-02-2018 " tarihinde saat 22:44 itibariyle sahika51 tarafından düzenlenmiştir....
sahika51 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 08-02-2018, 21:49   #2
sahika51
Altın Üye
 
Giriş: 28/10/2006
Mesaj: 42
Excel Vers. ve Dili:
2003
Varsayılan

Zor bir soruydu belki belkide yapılamaz bir şeydi. Belkide ben anlatamamışımdır.
sahika51 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 09-02-2018, 13:32   #3
Ömer BARAN
Uzman
 
Giriş: 08/03/2011
Şehir: ANKARA / İSTANBUL
Mesaj: 9,657
Excel Vers. ve Dili:
Office 2013 TÜRKÇE
Varsayılan

Merhaba.

Ya şöyle olursa diye ilave talebiniz olmayacaksa; mevcut örnek belgenize göre bir öneride bulunmak istedim.

UYARILAR:
►Kod ilgili satırda A sütununaki hücreyi kullanmaktadır. Bu nedenle A sütununu boş bırakın.
►E:I sütunlarındaki değerlerin tümünü silmek için C sütunundaki sayısal veriyi silmeniz yeterli olur.

Aşağıdaki şekilde işlem yaparsanız istediğiniz sonuca ulaşılacaktır.
-- Alt taraftan Sayfa1'in 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'u yapıştırın.
.
Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column < 3 Or Target.Column > 10 Then Exit Sub
If Target.Column = 3 And Int((Target.Row - 1) / 4) = (Target.Row - 1) / 4 And Cells(Target.Row, 3) = "" Then
    If Cells(Target.Row, 1) = "X" Then Exit Sub
        Cells(Target.Row, 1) = "X"
    Range(Cells(Target.Row, 5), Cells(Target.Row + 1, 9)) = "": Cells(Target.Row, 1) = "": Exit Sub
ElseIf Target.Column = 3 And Int((Target.Row - 1) / 4) = (Target.Row - 1) / 4 And Cells(Target.Row, 3) < 15 Then
    If Cells(Target.Row, 1) = "X" Then Exit Sub
        Cells(Target.Row, 1) = "X": Range(Cells(Target.Row + 1, 5), Cells(Target.Row + 1, 9)) = ""
    topl = Cells(Target.Row, 3): ustkisibasi = topl / 5
    Range(Cells(Target.Row, 5), Cells(Target.Row, 9)) = ustkisibasi: Cells(Target.Row, 1) = "": Exit Sub
ElseIf Target.Column = 3 And Int((Target.Row - 1) / 4) = (Target.Row - 1) / 4 Then
    If Target >= 15 Then
        Cells(Target.Row, 1) = "X": Range(Cells(Target.Row, 5), Cells(Target.Row, 9)) = 3: artan = Target - 15
        dolu = 5 - WorksheetFunction.CountBlank(Range(Cells(Target.Row, 5), Cells(Target.Row, 9)))
        artankisibasi = artan / dolu: ustkisibasi = 3
            For sut = 5 To 9
                If Cells(Target.Row, sut) > 0 Then Cells(Target.Row + 1, sut) = artankisibasi
            Next
        Cells(Target.Row, 1) = "": Exit Sub
    ElseIf Target < 15 Then
        topl = Cells(Target.Row, "X"): kisibasi = topl / 5
        Range(Cells(Target.Row + 1, 5), Cells(Target.Row + 1, 9)) = ""
        Range(Cells(Target.Row, 5), Cells(Target.Row, 9)) = kisibasi
    End If
ElseIf Target.Column > 4 And Target.Column < 10 And Int((Target.Row - 1) / 4) = (Target.Row - 1) / 4 Then
    If Cells(Target.Row, 1) = "X" Then Exit Sub
        Cells(Target.Row, 1) = "X"
            If Target = "" Then Cells(Target.Row + 1, Target.Column) = ""
        topl = Cells(Target.Row, 3)
            If topl >= 15 Then
                For sut = 5 To 9
                    dolu = 5 - WorksheetFunction.CountBlank(Range(Cells(Target.Row, 5), Cells(Target.Row, 9)))
                    artan = topl - 15: ustkisibasi = 15 / dolu: artankisibasi = artan / dolu
                    If Cells(Target.Row, sut) > 0 Then Cells(Target.Row, sut) = ustkisibasi
                    If Cells(Target.Row, sut) > 0 Then Cells(Target.Row + 1, sut) = artankisibasi
                Next
                Cells(Target.Row, 1) = "": Exit Sub
            End If
End If
End Sub
__________________
.
☾✭ İnadına TÜRKÇE ✭☽

-- Sorunuzu, gerçek belgenizle aynı yapıda ve olması gereken sonuçların elle yazıldığı örnek belge ile destekleyiniz.
-- ALTIN ÜYELİK öneriyorum. / FORUM KURALLARInı mutlaka okuyunuz.
-- ALTIN ÜYE olmayanlar, örnek belgeyi dosya.tc, dosya.co gibi bir siteye yükleyip, belgeye erişim adresini verebilir.
-- Özel mesaj ile soru sormayınız. / Geri bildirimde bulunulmayan cevaplarımı siliyorum.
Ömer BARAN Çevrimdışı   Alıntı Yaparak Cevapla
Eski 09-02-2018, 17:40   #4
sahika51
Altın Üye
 
Giriş: 28/10/2006
Mesaj: 42
Excel Vers. ve Dili:
2003
Varsayılan

Ömer Bey Teşekkür Ederim. Süpersiniz. İlave talep uyarınıza rağmen, Son bir kez rakamları dağıttığımızda ramaklar tam sayı olmalı. Örnek c ye 17 verelim ve bir herhangi bir günü örnek salı günü boş olsun. M satırı 3,75 Ü satırı 0,5 şeklinde doluyor. Bunları tam sayı dağıtamazmı.
sahika51 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 09-02-2018, 18:55   #5
Ömer BARAN
Uzman
 
Giriş: 08/03/2011
Şehir: ANKARA / İSTANBUL
Mesaj: 9,657
Excel Vers. ve Dili:
Office 2013 TÜRKÇE
Varsayılan

İlave talep geleceğini tahmin ettiğimden o şekilde yazmıştım.
Önce belge tasarımı ve iş akışının kafada netleşmesi gerekir, bu kısım tamam olduğunda mutlaka bir çözüm bulunur.

Bir örnekle netleştirelim:
► Önce C9'a 20 yazdınız.
-- E9:I9 arasına 3'erden toplam 15 dağıtıldı,
-- alt satıra ise geriye kalan 5 (20-15) sayıısı 1'er şeklinde dağıtıldı.
► Sonra G9'daki 3 sayısını sildiniz.
-- bu durumda silinen 3 sayısının E9, F9, H9 ve I9'a dağıtılması gerekmiyor mu?
-- G9 silindiğinde otomatik silinen G10'daki 1 sayısının da E10, F10, H10 ve I10'a dağıtılması gerekmiyor mu?

► İşlem akışı 1) C sütununa sayı yaz dağıtımı yap, 2) dağıtımı yapılan değerlerden üst satırdaki birini sil, daha sonra gerekli ise üst satırdan birini daha sil .... şeklinde,
silme işleminden sonra tekrar C sütununa bir sayı yazarsanız iş akışı başa döner ve tüm sütunlara dağıtılır.

► Başlangıçtaki isteğiniz:
-- hangi işlemi (yazma/silme) yaparsanız yapın, E9:I10 arası toplamının C9'a eşit olmasını siz istiyorsunuz.
-- (C9-15) / 5 işlemi sonucunun her zaman TAMSAYI OLMAYACAĞInı zaten öngörmediniz mi?
__________________
.
☾✭ İnadına TÜRKÇE ✭☽

-- Sorunuzu, gerçek belgenizle aynı yapıda ve olması gereken sonuçların elle yazıldığı örnek belge ile destekleyiniz.
-- ALTIN ÜYELİK öneriyorum. / FORUM KURALLARInı mutlaka okuyunuz.
-- ALTIN ÜYE olmayanlar, örnek belgeyi dosya.tc, dosya.co gibi bir siteye yükleyip, belgeye erişim adresini verebilir.
-- Özel mesaj ile soru sormayınız. / Geri bildirimde bulunulmayan cevaplarımı siliyorum.
Ömer BARAN Çevrimdışı   Alıntı Yaparak Cevapla
Eski 10-02-2018, 01:02   #6
sahika51
Altın Üye
 
Giriş: 28/10/2006
Mesaj: 42
Excel Vers. ve Dili:
2003
Varsayılan

Haklısınız ömer bey, Elinize sağlık. Uğraşmışınız. Ben Soruyu yazarken eksik, öngöremediğim veya mantığını doğru açıklayamadığım yerler var.
1- C9 hücresine 15ten aşağı sayıların yazılma ihtimali de var. Örneğin 13 olabilir. 13 sayısı e9-ı9 arasına dağıtılırken tam sayı olmalı. Örnek 3 3 3 2 2 gibi. veya bir hücreyi silersem 43 33 gibi dağıtmalı

2- c9 hücresine örneğin 20 yazarsam ve g9 hücresini silersem 20 sayısını 4 güne bölüp e9-ı9 örneğin 4 4 4 3 gibi yayabilir e10-ı10 arasını da 2 1 1 1 şeklinde olabilir.
sahika51 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 10-02-2018, 01:35   #7
Ömer BARAN
Uzman
 
Giriş: 08/03/2011
Şehir: ANKARA / İSTANBUL
Mesaj: 9,657
Excel Vers. ve Dili:
Office 2013 TÜRKÇE
Varsayılan

Tekrar merhaba.

Son yazdıklarınız tamamen yeni bir durum ve kodlamanın baştan ele alınmasını gerektirir ve malesef
önceki emeğin boşa gitmesi anlamına geliyor.

Umarım kodları, VBA ekranını açıp doğrudan yazdığımızı düşünmüyorsunuz.

Kod yazma işlemi; netice itibariyle adım adım ilerleyerek / denemeler yaparak / muhtemel uç durumlara ilişkin
önlemler-sınırlamalar eklenmesi/silinmesi gibi aşamaları olan biraz zahmetli / sabır isteyen bir iş.

Uygun olduğumda, zihnim berrak iken tekrar bakmaya çalışırım ancak yine cevap yazdığımda bu kez de;
başlangıç sütunu değişti/sağa doğru şu sütun gruplarında da aynı uygulama olsun/tablonun
başlangıç satırı değişti gibi kod'un revize edilmesi talebinin geleceğine kesin gözüyle bakıyorum doğrusu.

Bence ilk iş olarak; gerçek belgenizin özel bilgi içermeyen bir kopyasını ekleyin ki en azından uğraşıldığına değsin, değil mi?.
.
__________________
.
☾✭ İnadına TÜRKÇE ✭☽

-- Sorunuzu, gerçek belgenizle aynı yapıda ve olması gereken sonuçların elle yazıldığı örnek belge ile destekleyiniz.
-- ALTIN ÜYELİK öneriyorum. / FORUM KURALLARInı mutlaka okuyunuz.
-- ALTIN ÜYE olmayanlar, örnek belgeyi dosya.tc, dosya.co gibi bir siteye yükleyip, belgeye erişim adresini verebilir.
-- Özel mesaj ile soru sormayınız. / Geri bildirimde bulunulmayan cevaplarımı siliyorum.
Ömer BARAN Çevrimdışı   Alıntı Yaparak Cevapla
Eski 10-02-2018, 11:00   #8
sahika51
Altın Üye
 
Giriş: 28/10/2006
Mesaj: 42
Excel Vers. ve Dili:
2003
Varsayılan

Ömer Bey teşekkür ederim.
sahika51 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 11-02-2018, 00:01   #9
Ömer BARAN
Uzman
 
Giriş: 08/03/2011
Şehir: ANKARA / İSTANBUL
Mesaj: 9,657
Excel Vers. ve Dili:
Office 2013 TÜRKÇE
Varsayılan

Aşağıdaki kod istenilen işlemi yapacaktır.
Önceki cevabımda da belirttiğim gibi; kod, ilgili sütunda A sütununu kullanmaktadır.
Bu nedenle A sütununda veri bulundurmayınız.

.
Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column < 3 Or Target.Column > 10 Then Exit Sub
Set wf = Application.WorksheetFunction
If Target.Column = 3 And _
    Int((Target.Row - 1) / 4) = (Target.Row - 1) / 4 Then
    If Cells(Target.Row, 3) = "" Then
        Range("E" & Target.Row & ":I" & Target.Row + 1).ClearContents
        Exit Sub
    ElseIf Cells(Target.Row, 3) < 15 Then
        Cells(Target.Row, "A") = "X"
        Range("E" & Target.Row & ":I" & Target.Row + 1).ClearContents
        artan = Cells(Target.Row, 3) - Int(Cells(Target.Row, 3) / 5) * 5
        Range("E" & Target.Row & ":I" & Target.Row) = Int(Cells(Target.Row, 3) / 5)
            For sut = 5 To 4 + artan
                Cells(Target.Row, sut) = Cells(Target.Row, sut) + 1
            Next
        Cells(Target.Row, "A") = ""
    ElseIf Cells(Target.Row, 3) >= 15 Then
        Cells(Target.Row, "A") = "X"
        Range("E" & Target.Row & ":I" & Target.Row + 1).ClearContents
        tam = 3
        artan = Cells(Target.Row, 3) - tam * 5
        Range("E" & Target.Row & ":I" & Target.Row) = tam
                Range("E" & Target.Row + 1 & ":I" & Target.Row + 1) = Int(artan / 5)
                kalan = artan - Int(artan / 5) * 5
            For sut = 5 To 4 + kalan
                Cells(Target.Row + 1, sut) = Cells(Target.Row + 1, sut) + 1
            Next
        Cells(Target.Row, "A") = ""
    End If
ElseIf Target.Column > 4 And Target.Column < 10 And _
    Int((Target.Row - 1) / 4) = (Target.Row - 1) / 4 Then
    If Cells(Target.Row, 1) = "X" Then GoTo 10
    If wf.CountBlank(Range("E" & Target.Row & ":I" & Target.Row)) = 5 And _
        Cells(Target.Row, "C") <> "" Then
       Range("E" & Target.Row + 1 & ":I" & Target.Row + 1).ClearContents
        MsgBox "Üst satırda tüm değerleri sildiniz." & vbLf & _
            "C" & Target.Row & " hücresindeki değeri tekrar yazınız.", vbCritical
            Range("C" & Target.Row) = ""
        Exit Sub
    End If
On Error Resume Next
    If Target = "" Then
        althedef = wf.Sum(Range("E" & Target.Row + 1 & ":I" & Target.Row + 1))
        Cells(Target.Row + 1, Target.Column).ClearContents
        usthedef = wf.Min(Cells(Target.Row, "C"), 15)
        bosluk = wf.CountBlank(Range("E" & Target.Row & ":I" & Target.Row))
        For sut = 5 To 9
            If Cells(Target.Row, sut) <> "" Then _
                Cells(Target.Row, sut) = Int(usthedef / (5 - bosluk))
            If Cells(Target.Row + 1, sut) <> "" Then _
            Cells(Target.Row + 1, sut) = Int(althedef / (5 - bosluk))
        Next
        For s = 5 To 9
            If Cells(Target.Row, s) <> "" And _
                wf.Sum(Range("E" & Target.Row & ":I" & Target.Row)) < usthedef Then
                Cells(Target.Row, s) = Cells(Target.Row, s) + 1
            End If
            If Cells(Target.Row + 1, s) <> "" And _
                wf.Sum(Range("E" & Target.Row + 1 & ":I" & Target.Row + 1)) < althedef Then
                Cells(Target.Row + 1, s) = Cells(Target.Row + 1, s) + 1
            End If
        Next
10: End If
End If
End Sub
__________________
.
☾✭ İnadına TÜRKÇE ✭☽

-- Sorunuzu, gerçek belgenizle aynı yapıda ve olması gereken sonuçların elle yazıldığı örnek belge ile destekleyiniz.
-- ALTIN ÜYELİK öneriyorum. / FORUM KURALLARInı mutlaka okuyunuz.
-- ALTIN ÜYE olmayanlar, örnek belgeyi dosya.tc, dosya.co gibi bir siteye yükleyip, belgeye erişim adresini verebilir.
-- Özel mesaj ile soru sormayınız. / Geri bildirimde bulunulmayan cevaplarımı siliyorum.
Ömer BARAN Çevrimdışı   Alıntı Yaparak Cevapla
Eski 12-02-2018, 17:16   #10
sahika51
Altın Üye
 
Giriş: 28/10/2006
Mesaj: 42
Excel Vers. ve Dili:
2003
Varsayılan

Ömer bey tam istediğm gibi elinize sağlık. Çok teşekkür ederim.
sahika51 Çevrimdışı   Alıntı Yaparak Cevapla
Yanıtla


Konu Araçları
Görünüm Modları

Gönderme Kuralları
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is Açık
SimgelerAçık
[IMG] kodu Açık
HTML kodu Kapalı


Saat 23:29


Bu forum Elit NET - www.elitnet.com.tr tarafından sunulmaktadır.

Excel Eğitimi - Mobil Uygulama - Çorlu - Çorlu Web Tasarım -- Beylikdüzü mali müşavir - Beylikdüzü mali müşavir - Lingerie - Dyeing Machine - Karton Bardak- Karton Bardak- Çorlu Dil Konuşma Terapisti- Çorlu Dil Konuşma Terapisti- Çorlu Konuşma Terapisti- Çorlu Konuşma Terapisti- Çorlu Özel Eğitim- Site Yönetimi- Pronet Tekirdağ- Çorlu Kamera- Pronet Edirne- Pronet Çorlu- Çorlu Araç Takip- Çorlu Su Arıtma- Gebze Emlak- Rampa- Rotary- Çorlu İnternet Sitesi- Çorlu Sürücü Kursu- Çorlu Sürücü Kursu- Şişli Avukat- Edirne Serbest Muhasebeci- Çorlu Etüt- İstanbul Botanik- Çorlu Sigorta- Kağıt Bardak- Kağıt Bardak- Kaplan Tekstil- Çorlu Perde- Çorlu Perde- Çorlu Havuz- Çorlu Havuz- Makina- Danışmazlar- Çorlu Perde Yıkama- Çorlu Perde Yıkama- Okul Danışmanlık- Çorlu Ayakkabı- İzmit Sigorta-
Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.
Advertisement System V2.6 By   Branden