• DİKKAT

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

Makro çoğaltma işlemi ?

T

tayfurenes

Katılım
28 Nisan 2017
Mesajlar
8
Excel Vers. ve Dili
office 2016
türkçe
windows 10 pro 64bit
HERKESE MERHABALAR
ÖNCELİKLE FORUMDAKİ PAYLAŞIMLAR VE YARDIMLARDAN ÖTÜRÜ TEŞEKKÜRLER
EXCEL ÜZERİNDEN BİR PROGRAM YAZMAKTAYIM
ÇOK DERİN BİLGİLERE SAHİP DAĞİLİM
BU SEBEPTEN ÖTÜRÜ YARDIMLARINIZI ARZ EDERİM

EXCEL DE BİR VERESİYE TAKİP PROGRAMI DÜŞÜNÜN
BİR ANA SAYFA DA KİŞİ İSİMLERİ YER ALIYOR
HER KİŞİ İÇİN AYRI BİR SAYFA
BU NEDENLE HER KİŞİ İÇİN AYRI AYRI MAKRO KOPYALAMAM GEREKİYOR
SİZE ÖRNEK BİR MAKRO GİREYİM
Kod: 
Sub VERE1()
'
' VERE1 Makro
'

'
    Range("G6:J6").Select
    Selection.Copy
    Range("G18").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Rows("18:18").Select
    Application.CutCopyMode = False
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("G19").Select
    Sheets("KİŞİ").Select
    Range("E8").Select
    Selection.Copy
    Range("G13").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("G19").Select
    Sheets("KİŞİ").Select
    Sheets("Ödemeler").Visible = True
    Sheets("KİŞİ").Select
    Range("G6").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Ödemeler").Select
    Range("D3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("KİŞİ").Select
    Range("H6").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Ödemeler").Select
    Range("H3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("KİŞİ").Select
    Range("J6").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Ödemeler").Select
    Range("F3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("KİŞİ").Select
    Range("J2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Ödemeler").Select
    Range("E3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("KİŞİ").Select
    Range("E8").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Ödemeler").Select
    Range("B3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("B3").Select
    Sheets("Ödemeler").Select
    Application.CutCopyMode = False
    ActiveSheet.Unprotect
    Rows("3:3").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("B3").Select
    Sheets("Ödemeler").Select
    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
        AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
        :=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
        AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
        AllowUsingPivotTables:=True
    Sheets("Ödemeler").Select
    ActiveWindow.SelectedSheets.Visible = False
End Sub

YUKARIDAKİ KOD U AŞAĞIDA Kİ ŞEKİLDE DEVAM ETTİRMEM GEREKİYOR

Kod: 
Sub VERE2()
'
' VERE1 Makro
'

'
    Range("G6:J6").Select
    Selection.Copy
    Range("G18").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Rows("18:18").Select
    Application.CutCopyMode = False
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("G19").Select
    Sheets("KİŞİ (2)").Select
    Range("E8").Select
    Selection.Copy
    Range("G13").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("G19").Select
    Sheets("KİŞİ (2)").Select
    Sheets("Ödemeler").Visible = True
    Sheets("KİŞİ (2)").Select
    Range("G6").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Ödemeler").Select
    Range("D3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("KİŞİ (2)").Select
    Range("H6").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Ödemeler").Select
    Range("H3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("KİŞİ (2)").Select
    Range("J6").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Ödemeler").Select
    Range("F3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("KİŞİ (2)").Select
    Range("J2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Ödemeler").Select
    Range("E3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("KİŞİ (2)").Select
    Range("E8").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Ödemeler").Select
    Range("B3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("B3").Select
    Sheets("Ödemeler").Select
    Application.CutCopyMode = False
    ActiveSheet.Unprotect
    Rows("3:3").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("B3").Select
    Sheets("Ödemeler").Select
    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
        AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
        :=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
        AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
        AllowUsingPivotTables:=True
    Sheets("Ödemeler").Select
    ActiveWindow.SelectedSheets.Visible = False[CODE]
End Sub[/CODE]

KİŞİ SAYFALARI ("KİŞİ" , "KİŞİ (2)" , "KİŞİ (3)" ) ŞEKLİNDE DEVAM EDİYOR

200 KİŞİ OLURŞTURMAM GEREKYOR

HER KİŞİ İÇİN BU KODU KOPYALAYIP "KİŞİ" SATIRLARINI VE "MAKRO" İSİMLERİNİ DÜZENLEMEM GEREK
BUNUN YERİNE BUNU YAPACAK DAHA PRATİK BİR YOL VARMIDIR?

-----------------------------------------
YUKARIDA BELİRTTİĞİM OLAY GİBİ DE
AŞAĞIDA GİRDİĞİM KODLARI DA AYNI ŞEKİLDE KOPYALAMAM GEREK


Kod: 
Sub İ1()
'
' İ1 Makro
'

'
    Sheets("VERESİYE").Select
    Sheets("kişi").Visible = True
    Sheets("VERESİYE").Select
    ActiveWindow.SelectedSheets.Visible = False
End Sub

Kod: 
Sub İ2()
'
' İ2 Makro
'

'
    Sheets("VERESİYE").Select
    Sheets("KİŞİ (2)").Visible = True
    Sheets("VERESİYE").Select
    ActiveWindow.SelectedSheets.Visible = False
End Sub

HERKESE KOLAYLIKLAR DİLER ŞİMDİDEN TEŞEKKÜR EDERİM...
 
Her sayfaya makro yerleştirmek yerine bir sayfadan veri girişini kontrol etmek daha kolay olur.
 
öncelikle ilgi için teşekkür ederim

muhammet okumuş' Alıntı:
her sayfaya makro yerleştirmek yerine bir sayfadan veri girişini kontrol etmek daha kolay olur.
Genişletmek için tıkla ...

veri girişini kontrol etmeyi düşündüm
ancak bu veri girişi bazı işlerime engel olabilir
bir kişi nin sayfasında bir veresiye girişi yaptığım zaman
bu hem kişinin sayfasına
hemde ödemeler adlı ortak sayfaya giriş işlemi yapıyor
veri girişi kontrolü kişiye özel bir sayfa oluşturmama
olanak vermiyor ya da ben öyle düşünüyorum
eğer yararlı olacaksa size bu programın bir kopyasını atabilirim
 
Bir bakayim. En azindan fikir verebilirim. Bir siteye upload edin
 
şu anda veri doğrulama deniyorum
çözemezsem hemen atayım :)
 
Hallettim :)

KONUYU SÖYLEMEK İSTEDİĞİM ŞEKİLDE DEĞİLDE
VERİ DOĞRULAMASI YAPARAK HALLETTİM
SIFIR BAŞTAN Bİ PROGAM YAZDIM AMA OLSUN DEĞDİ :)

https://drive.google.com/open?id=0B7uEHrCa-9LDYU1yRGlZNUpwaG8

HERŞEY İÇİN TEŞEKKÜR EDER
KOLAYLIKLAR DİLERİM

NOT: BU PROGRAMDA ÇOK EMEĞİM VAR
GERÇEKTEN ÇOK UĞRAŞTIRDI BENİ
KULLANANLAR İÇİN BİR TEŞEKKÜR ÇOK OLMAZ DİYE DÜŞÜNÜYORUM
DİPNOT: MAİL MAKROSUNU KENDİNİZE GÖRE DÜZELTMENİZ GEREKMEKTE , AKSİ HALDE YEDEKLE TUŞU Bİ İŞ GÖRMEZ
AYNI ZAMANDA MAKRO DÜZENLENDİKTEN SONRA ONEDRIVE PROGRAMINDAN AYAR ÇEKMENİZ DE GEREKEBİLİR
BURADA YER ALAN YEDEKLE TUŞU DOSYAYI MAİL OLARAK GÖNDERME İŞLEVİ GÖRÜR

ŞİFRE :
Kod: 
14456
 
Son düzenleme:
Selamlar Tesekkur ederim Proramını inceledim İyi calısma yapmısınız
 
sayın parametre , programda kayıt gir sayfası girilen değerleri ödemeler sayfasına girer, bu ödemeler sayfası girilen tarih te kırmızı olur ve (programdan ana sayfa daki çıkış tuşuna basarak çıkmak suretiyle çıkılrsa) her açıldığında günü gelen ödemeyi textbox olarak uyarı verir
bu tarihte tahsilatı olan kişiler;
diye...
benim buradaki tarihi şu şekilde düzeltme şansım varmı;
örneğin girilen tarih taksitli bir ödeme
her ayın 15 inde ödeme yapılacak gibi
aynı zamanda taksitsiz ödemeler de olacak
girilen tarih gelirse diye
 
tayfurenes' Alıntı:
sayın parametre , programda kayıt gir sayfası girilen değerleri ödemeler sayfasına girer, bu ödemeler sayfası girilen tarih te kırmızı olur ve (programdan ana sayfa daki çıkış tuşuna basarak çıkmak suretiyle çıkılrsa) her açıldığında günü gelen ödemeyi textbox olarak uyarı verir
bu tarihte tahsilatı olan kişiler;
diye...
benim buradaki tarihi şu şekilde düzeltme şansım varmı;
örneğin girilen tarih taksitli bir ödeme
her ayın 15 inde ödeme yapılacak gibi
aynı zamanda taksitsiz ödemeler de olacak
girilen tarih gelirse diye
Genişletmek için tıkla ...

konu güncel ..
cevap bekleniyor
 
Bunu ancak koşullu biçimlendirme ile yapabiliriz makro olarak oluşturamadım bir bolum açarsınız veresiye olan yerde veresiye yazar ona göre kontrol oluşturabilirsiniz kolay gelsin
 
tam olarak anlayamadım , kusurumu maruz görün
benim burada benim hatırlarma olarak kullandığım;
textbox
burada tarih şeklinde aratıyor bu günün tarihini bulursa 5. kutucuktaki ismi vererek hatırlatmada bulunuyor.
burada aradığı gün/ay/yıl olarak
benim istediğim şey , bu hatırlatmanın gün/ay şeklinde bakması ve denk gelen kutucuklara bakması şeklinde...
bunu yanlış düşünmüyorsam eğer, hem hücre içinde bir kodlama olması , hemde
textbox kodlaması olması. ancak bunu nasıl yapabileceğimi bilemiyorum
şimdiden teşekkür eder, kolaylıklar dilerim
 
iki tarih arasındaki farkı gün olarak buluyor
Kod: 
Target.Offset(0, -2) = CDate(Target.Offset(0, -3).Value) - CDate(Target.Offset(0, -4).Value)

Ömer BARAN'ın İzniyle
Kod: 
fikir vermesi acısından 
I16'da küçük tarih, I17'de büyük tarih varsa;
yıl = Evaluate("=DATEDIF(I16,I17,""y"")")
ay = Evaluate("=DATEDIF(I16,I17,""ym"")")
gün = Evaluate("=DATEDIF(I16,I17,""md"")")

bir ornek burada mevcut

kodları kendinize gore duzenleyiniz kolay gelsin
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst