makro kullanarak farklı klasöra yazdırma

[eseseski]

makro kullanarak farklı dosyalara yazdırma

çalışma klasöründe g.görev sütununa isim girdiğimizde 2 numaralı klasördeki g.görev sütununda ismin karşılığına mahmudiye yazısını nasıl yazdırabilirim
bilgisi olanlar yardım edebilirmi

 

[mancubus]

aşağıda yazacaklarım yanlış algı yaratmaz umarım.

klasör farklı bir şey... klasör işlemleri yapmak için kod yazmak ta o açıdan farklı.

sizin demek istediğiniz dosya. ekledikleriniz de dosya zaten.

konu başlığını okuyan birisi klasör işlemleri için makro yazmayı bilmiyorsa konuya hiç girmeyecektir. bu nedenle, eğer bu kişi dosyalarda işlem yapmayı biliyor ise, belki de bildiği bir konuda, konu başlığı yanlış yazıldığı için cevap veremeyecektir.



bunları dedikten sonra, eğer doğru anladı isem, kod aşağıdadır.
"çalışma.xls" isimli dosyada "Sayfa1" sayfasının kod modülüne kopyalanmaladır.

yaptığı iş:
"çalışma.xls" isimli dosyada "Sayfa1" sayfasında F sütununa bir değer girildiğinde, bu girilen değeri "2.xls" isimli dosyanın "Sayfa1" sayfasının "A" sütununda aramakta, bulduğu takdirde, yanına, "B" sütununa "Mahmudiye" kelimesini yazmaktadır.

dikkat: dosyaların her ikisi de açık olmalıdır.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim wb As Workbook
Dim satBul As Long

If Target.Count > 1 Then Exit Sub
If Intersect(Target, Columns("F")) Is Nothing Then Exit Sub

Set wb = Workbooks("2.xls")
satBul = Application.Match(Target.Value, wb.Worksheets("Sayfa1").Columns("A"), 0)

wb.Worksheets("Sayfa1").Cells(satBul, "B").Value = "Mahmudiye"

End Sub

 

[eseseski]

peki çalışma dosyasındaki a sütunundaki tarih aralığınıda 2.xls dosyasında mahmudiye yazdırdığımız yere açıklama kısmına aktarabilirmiyiz

 

[mancubus]

soruyu tam anlayamadım.

Mahmudiye'nin yerine mi yazılacak?

wb.Worksheets("Sayfa1").Cells(satBul, "B").Value = Target.Offset(, -5).Value

Mahmudiye ile birlikte, örneğin parantez içine mi?

wb.Worksheets("Sayfa1").Cells(satBul, "B").Value = "Mahmudiye (" & Target.Offset(, -5).Value & ")"

Mahmudiye ile birlikte arada boşluk bırakarak mı?

wb.Worksheets("Sayfa1").Cells(satBul, "B").Value = "Mahmudiye " & Target.Offset(, -5).Value

 

[eseseski]

hücreyi sağ tıkladığımızda açıklama ekle kısmına

 

[mancubus]

Private Sub Worksheet_Change(ByVal Target As Range)

Dim wb As Workbook
Dim satBul As Long

If Target.Count > 1 Then Exit Sub
If Intersect(Target, Columns("F")) Is Nothing Then Exit Sub

Set wb = Workbooks("2.xls")

On Error Resume Next
satBul = Application.Match(Target.Value, wb.Worksheets("Sayfa1").Columns("A"), 0)
If Err.Number = 0 Then
    wb.Worksheets("Sayfa1").Cells(satBul, "B").Value = "Mahmudiye"
    wb.Worksheets("Sayfa1").Cells(satBul, "B").Comment.Delete
    wb.Worksheets("Sayfa1").Cells(satBul, "B").AddComment Text:=Target.Offset(, -5).Text
Else
    Exit Sub
End If
On Error GoTo 0

End Sub

 

[eseseski]

çokteşekür ederim üstadım emeğinize sağlık

 

[mancubus]

rica ederim.
kolay gelsin...

 

[eseseski]

diğer sayfalara makro uygulamak

eklemiş olduğum çalışma dosyasında yukarıdaki makroyu diğer sayfalara nasıl uygulayabiliriz yani sayfa 2deki yapılan bir işlemde 2.xls dosyasında sayfa 1 deki yapılan işlemi silmeden açıklama sayfasına ilaveten yeni tarihide (sayfa 2 deki) ekleyebilirmiyiz
ayrıca çalışma .xls dosyasında yapılan bir değişiklikte 2.xls doayasından silinmiyor bu nasıl çözülebilir
ilgilenenlere şimdiden teşekkür ederim

 

[eseseski]

bilgisi olanlar????

 

[mancubus]

sıkıntı şu ki, talepler net açıklanamıyor.
o zaman da cevap verecek üye sayısı azalıyor.


dosyaya tekrar baktım.
benim eklediğim kodlarda wb.Worksheets("Sayfa1") ifadesi wb.Worksheets("Sayfa1",) dönüşmüş. yanına bir , eklenmiş. neden?


ben anladığım üzerinden cevap vereyim:
- sayfa 1'de F sütununa girildiğinde gerçekleşen olaylar diğer sayfalarda F sütununa girildiğinde de olsun.
- eğer 2.xls'de daha önce girilmiş bir hücre açıklaması var ise bu kalsın ve yenisi eklensin.

çalışma xls dosyasındaki tüm kodları silerek aşağıdaki kodu DEĞİŞTİRMEDEN BuÇalışmaKitabı kod modülüne (VBE'de üzerine çift tıklayarak sağında açılan boş pencereye) kopyala.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

Dim wb As Workbook
Dim satBul As Long
Dim comm As String

If Target.Count > 1 Then Exit Sub
If Intersect(Target, Columns("F")) Is Nothing Then Exit Sub

Set wb = Workbooks("2.xls")

On Error Resume Next
satBul = Application.Match(Target.Value, wb.Worksheets("Sayfa1").Columns("A"), 0)
If Err.Number = 0 Then
    With wb.Worksheets("Sayfa1").Cells(satBul, "B")
        .Value = "Mahmudiye"
        comm = .Comment.Text
        .Comment.Delete
        .AddComment Text:=comm & " " & Target.Offset(, -5).Text
    End With
Else
    Exit Sub
End If
On Error GoTo 0

End Sub

 

[eseseski]

haklısınız düşündüklerimizi tam olarak anlatamıyoruz
sayfa 1 in yanına eklenen , tamamen bilgisizlik, gözden kaçan bir hata,eksik bilgimizle sorunu çözmeye çalışma
anlayışınız ve yardımlarınız için teşekküe ederim

 

[mancubus]

rica ederim.
kolay gelsin.

 

[eseseski]

değerli mancubus hocam söylediğiniz gibi kodu uyguladım fakat kodu çalıştıramadım bi kontrol etmeniz mümkünmüdür saygılarımla

 

[mancubus]

ben deneyerek olduğunu gördüm.
çalışmayan dosyaları yükleyelim.

 

[eseseski]

çalıştıramadığım dosyalar

dediğiniz gibi değiştirmeden aynen vbe de uyguladım bi bakarsanız

 

[mancubus]

benim dediğim gibi yapılmamış:

çalışma xls dosyasındaki tüm kodları silerek aşağıdaki kodu DEĞİŞTİRMEDEN BuÇalışmaKitabı kod modülüne (VBE'de üzerine çift tıklayarak sağında açılan boş pencereye) kopyala.

sayfaya değil ThisWorkbook veya Türkçe excel için yukarıda yazdığım kod modülüne. Sayfada olan ise silinecek.