İki vba kodunun birleştirilmesi SORUN!

Etamustafa · 31 Ocak 2018

formda da bir kaç örnegini görsemde iki kodu birleştiremedim. Vba kodunu bilen arkadaşlar için basit olsa gerek ama bilmeyen için zor. Kodu aşagıda mevcut birleştirme yapsanız bile kısaca olsa tam neye dikkat edecegimizide yazarsanız sevinirim.

Private Sub Worksheet_Change(ByVal Target As Range)
alan = "I2:I" & Cells(Rows.Count, "A").End(3).Row
If Intersect(Target, Range(alan)) Is Nothing Then Exit Sub
Set wf = Application.WorksheetFunction
Set m = Sheets("MESAİ"): Set md = Sheets("MESAİDATA")
If wf.CountIf(m.[C:C], md.Cells(Target.Row, "B")) = 0 Or _
wf.CountIf(m.[3:3], md.Cells(Target.Row, "A")) = 0 Then Exit Sub
sat = wf.Match(md.Cells(Target.Row, "B"), m.[C:C], 0) + 2
sut = wf.Match(md.Cells(Target.Row, "A"), m.[3:3], 0)
With m.Cells(sat, sut)
.ClearComments
If Target <> "" Then
.AddComment: .Comment.Text Text:=Target.Text
End If
End With
End Sub

BİRLEŞECEK DİGER VBA KODU

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B3:B9]) Is Nothing Then Exit Sub

Cells(Target.Row, "C").Value = Application.WorksheetFunction.VLookup(Cells(Target.Row, "B"), Sheets("SÜRÜCÜ").Range("A:E"), 2, 0)
Cells(Target.Row, "D").Value = Application.WorksheetFunction.VLookup(Cells(Target.Row, "B"), Sheets("SÜRÜCÜ").Range("A:E"), 4, 0)

End Sub

Ömer BARAN · 31 Ocak 2018

Merhaba.

Verdiğiniz bilgilere göre kod'un işlem yapacağı alan;
-- I sütununda, I2'den A sütunundaki son dolu satıra kadarki (A sütunundaki dolu hücrenin bulunduğu satır numarasına göre satır aralığı değişken) alan,
-- B sütununda ise 3 - 9'uncu satır aralığı (satır numaraları sabit) .

Eğer bu doğru ise aşağıdaki gibi deneyin.

Sorun ile karşılaşırsanız, gerçek belgeyle aynı yapıda bir örnek belge üzerinde istediğiniz hususu örneklendirerek açıklama yapınız.
.

Kod:

[B]Private Sub Worksheet_Change(ByVal Target As Range)[/B]
alan = "[COLOR="Blue"][B]I2:I[/B]" & Cells(Rows.Count, "A").End(3).Row[/COLOR] & ", [COLOR="Red"][B]B3:B9[/B][/COLOR]"
If Intersect(Target, Range(alan)) Is Nothing Then Exit Sub
Set wf = Application.WorksheetFunction
Set m = Sheets("MESAİ"): Set md = Sheets("MESAİDATA"): Set s = Sheets("SÜRÜCÜ")

    If Target.Column = 9 Then
        If wf.CountIf(m.[C:C], md.Cells(Target.Row, "B")) = 0 Or _
            wf.CountIf(m.[3:3], md.Cells(Target.Row, "A")) = 0 Then Exit Sub
        sat = wf.Match(md.Cells(Target.Row, "B"), m.[C:C], 0) + 2
        sut = wf.Match(md.Cells(Target.Row, "A"), m.[3:3], 0)
        With m.Cells(sat, sut)
            .ClearComments
            If Target <> "" Then
                .AddComment: .Comment.Text Text:=Target.Text
            End If
        End With
        Exit Sub
    ElseIf Target.Column = 2 Then
        m.Cells(Target.Row, "C") = wf.VLookup(m.Cells(Target.Row, "B"), s.Range("A:E"), 2, 0)
        m.Cells(Target.Row, "D") = wf.VLookup(m.Cells(Target.Row, "B"), s.Range("A:E"), 4, 0)
        Exit Sub
    End If

[B]End Sub[/B]

Etamustafa · 31 Ocak 2018

Ömer BARAN' Alıntı:
Merhaba.

Verdiğiniz bilgilere göre kod'un işlem yapacağı alan;
-- I sütununda, I2'den A sütunundaki son dolu satıra kadarki (A sütunundaki dolu hücrenin bulunduğu satır numarasına göre satır aralığı değişken) alan,
-- B sütununda ise 3 - 9'uncu satır aralığı (satır numaraları sabit) .

Eğer bu doğru ise aşağıdaki gibi deneyin.

Sorun ile karşılaşırsanız, gerçek belgeyle aynı yapıda bir örnek belge üzerinde istediğiniz hususu örneklendirerek açıklama yapınız.
.

Kod:

[B]Private Sub Worksheet_Change(ByVal Target As Range)[/B] alan = "[COLOR="Blue"][B]I2:I[/B]" & Cells(Rows.Count, "A").End(3).Row[/COLOR] & ", [COLOR="Red"][B]B3:B9[/B][/COLOR]" If Intersect(Target, Range(alan)) Is Nothing Then Exit Sub Set wf = Application.WorksheetFunction Set m = Sheets("MESAİ"): Set md = Sheets("MESAİDATA"): Set s = Sheets("SÜRÜCÜ") If Target.Column = 9 Then If wf.CountIf(m.[C:C], md.Cells(Target.Row, "B")) = 0 Or _ wf.CountIf(m.[3:3], md.Cells(Target.Row, "A")) = 0 Then Exit Sub sat = wf.Match(md.Cells(Target.Row, "B"), m.[C:C], 0) + 2 sut = wf.Match(md.Cells(Target.Row, "A"), m.[3:3], 0) With m.Cells(sat, sut) .ClearComments If Target <> "" Then .AddComment: .Comment.Text Text:=Target.Text End If End With Exit Sub ElseIf Target.Column = 2 Then m.Cells(Target.Row, "C") = wf.VLookup(m.Cells(Target.Row, "B"), s.Range("A:E"), 2, 0) m.Cells(Target.Row, "D") = wf.VLookup(m.Cells(Target.Row, "B"), s.Range("A:E"), 4, 0) Exit Sub End If [B]End Sub[/B]

Run-time error '1004'
WorksheetFunction sınıfının VLookup özelliği alınamıyor
hatası veriyor hocam

Ömer BARAN · 31 Ocak 2018

Demekki B sütununa, arama alanında olmayan değer de yazabiliyorsunuz.

Kod'un aşağıdaki kırmızı renklendirdiğim Elseif...End If arasını aşağıdaki şekilde değiştirerek deneyin.
.

Kod:

[COLOR="Red"]ElseIf Target.Column = 2 Then[/COLOR]
        If wf.Countif(m.Cells(s.Range("A:A"),Target.Row, "B"))>0 Then
                m.Cells(Target.Row, "C") = wf.VLookup(m.Cells(Target.Row, "B"), s.Range("A:E"), 2, 0)
                m.Cells(Target.Row, "D") = wf.VLookup(m.Cells(Target.Row, "B"), s.Range("A:E"), 4, 0)
                Exit Sub
        End If
[COLOR="red"]End If[/COLOR]

Etamustafa · 31 Ocak 2018

Farklıda olsa sorun devam etmekte

Ömer BARAN' Alıntı:
Demekki B sütununa, arama alanında olmayan değer de yazabiliyorsunuz.

Kod'un aşağıdaki kırmızı renklendirdiğim Elseif...End If arasını aşağıdaki şekilde değiştirerek deneyin.
.

Kod:

[COLOR="Red"]ElseIf Target.Column = 2 Then[/COLOR] If wf.Countif(m.Cells(s.Range("A:A"),Target.Row, "B"))>0 Then m.Cells(Target.Row, "C") = wf.VLookup(m.Cells(Target.Row, "B"), s.Range("A:E"), 2, 0) m.Cells(Target.Row, "D") = wf.VLookup(m.Cells(Target.Row, "B"), s.Range("A:E"), 4, 0) Exit Sub End If [COLOR="red"]End If[/COLOR]

Hocam örnek dosyayı yükledim dosya üzerinden yardımcı olursanız sevinirim.
Belkide her şey dogru bizim acemi el mi acaba işi karıştırıyor end Sub uyarsı veriyor devamlı.

Ömer BARAN · 1 Şubat 2018

Tekrar merhaba.

Cevap yazmak için müsait değilim ama hemen şunu söyleyeyim.
İşleme ilişkin hala herhangi bir açıklama yazmamışsınız (her iki kod'un çalışacağı sayfa/alan anlamında) .
Daha önce, mecburen tahmin üzerine (fal bakar gibi) cevap oluşturmuş idim.
Dosya içerisine açıklama ekleyerek örnek belgeyi yenilemenizde yarar var.

Etamustafa · 1 Şubat 2018

Hocam kusuruma bakmayın!

Ömer BARAN' Alıntı:
Tekrar merhaba.

Cevap yazmak için müsait değilim ama hemen şunu söyleyeyim.
İşleme ilişkin hala herhangi bir açıklama yazmamışsınız (her iki kod'un çalışacağı sayfa/alan anlamında) .
Daha önce, mecburen tahmin üzerine (fal bakar gibi) cevap oluşturmuş idim.
Dosya içerisine açıklama ekleyerek örnek belgeyi yenilemenizde yarar var.

mesaidata b368 hücresine açıklama ekledim

Ömer BARAN · 1 Şubat 2018

Malesef yine tam anlamadım.

İstediğiniz, MESAİDATA sayfası B sütununa isim yazıldığında, hemen yanındaki hücreye bu ismin SÜRÜCÜ sayfasında karşısında bulunan plakanın yazılması mıdır?

O zaman diyelim ki; ad ile soyad arasına 1 yerine 2 boşluk koyuldu veya ad soyad bir/birkaç harfi yanlış olarak yazıldı ya da SÜRÜCÜ sayfasında olmayan bir isim yazıldı.
Bu durumda ne yapılacak?
(Yazım hatasını engellemek için;MESAİDATA sayfası B sütununa, SÜRÜCÜ sayfasındaki isim listesini kullanarak
VERİ DOĞRULAMA -> LİSTE yöntemi uygulanıp, ad soyad'ın elle yazılması yerine listeden seçilmesi düşünülebilir.)

O halledidiğinde, kod'daki ikinci işlem olan ..Cells(Target.Row, "D") = wf.VLookup(....Range("A:E"), 4....)
kısmı gereğince MESAİDATA sayfası B sütununa ismi yazılan kişinin satırında D sütununa,
bu isme SÜRÜCÜ sayfasında denk gelen D sütunundaki değer yazılacak gibi anlaşılıyor.
Ancak MESAİDATA sayfası D sütunu BAŞLANGIÇ SAATİ sütunu, bu durumda ne olacak?

Bu arada iki kod'un tetikleneceği ve işlem yapacağı alanların satır numaralarının birbirinden farklı olduğunu fark etmişsinizdir.
Birinci kod MESAİDATA sayfası I sütununun bütününde işlem yapacak anlaşılıyor ama ikinci kod için ilgil alanı B3:B9 aralığı.
Bu kod da, B sütunun tamamında işlem görecek şekilde değişecek mi?

Açıklama yazarken herbir değişken/işlem için sayfa adı ve hücre adresini net şekilde belirterek;
nereye ne yazıldığında, nereye neredeki bilginin yazılacağını daha net ifade etmelisiniz.
Belki de siz yeterince net yazdığınızı düşünüyorsunuz ama ben anlayamadım.
Neticede; belge ve tasarım sizin, işlemlerin kullanış bakımından akışını siz biliyorsunuz ama ben bilmiyorum.
.

Etamustafa · 2 Şubat 2018

Eksik açıklama yapmış olabilirim bence!

Ömer BARAN' Alıntı:
Malesef yine tam anlamadım.

İstediğiniz, MESAİDATA sayfası B sütununa isim yazıldığında, hemen yanındaki hücreye bu ismin SÜRÜCÜ sayfasında karşısında bulunan plakanın yazılması mıdır?

O zaman diyelim ki; ad ile soyad arasına 1 yerine 2 boşluk koyuldu veya ad soyad bir/birkaç harfi yanlış olarak yazıldı ya da SÜRÜCÜ sayfasında olmayan bir isim yazıldı.
Bu durumda ne yapılacak?
(Yazım hatasını engellemek için;MESAİDATA sayfası B sütununa, SÜRÜCÜ sayfasındaki isim listesini kullanarak
VERİ DOĞRULAMA -> LİSTE yöntemi uygulanıp, ad soyad'ın elle yazılması yerine listeden seçilmesi düşünülebilir.)

O halledidiğinde, kod'daki ikinci işlem olan ..Cells(Target.Row, "D") = wf.VLookup(....Range("A:E"), 4....)
kısmı gereğince MESAİDATA sayfası B sütununa ismi yazılan kişinin satırında D sütununa,
bu isme SÜRÜCÜ sayfasında denk gelen D sütunundaki değer yazılacak gibi anlaşılıyor.
Ancak MESAİDATA sayfası D sütunu BAŞLANGIÇ SAATİ sütunu, bu durumda ne olacak?

Bu arada iki kod'un tetikleneceği ve işlem yapacağı alanların satır numaralarının birbirinden farklı olduğunu fark etmişsinizdir.
Birinci kod MESAİDATA sayfası I sütununun bütününde işlem yapacak anlaşılıyor ama ikinci kod için ilgil alanı B3:B9 aralığı.
Bu kod da, B sütunun tamamında işlem görecek şekilde değişecek mi?

Açıklama yazarken herbir değişken/işlem için sayfa adı ve hücre adresini net şekilde belirterek;
nereye ne yazıldığında, nereye neredeki bilginin yazılacağını daha net ifade etmelisiniz.
Belki de siz yeterince net yazdığınızı düşünüyorsunuz ama ben anlayamadım.
Neticede; belge ve tasarım sizin, işlemlerin kullanış bakımından akışını siz biliyorsunuz ama ben bilmiyorum.
.

Şu şekilde açıklama getireyim Hocam.
*Sürücü isimleri pek değişken olmuyor yeni bir sürücü ilave oldugu zaman ilk önce Sürücü sayfasına ekleyeceğiz ondan sonra MesaiData kısmına sürücünün ismini yazarak devam edeceğiz.
( veri doğrulama gerek duymadık isimler hemen 15 kişi oldugu için excel biz isimlerin baş harflerini yazdığımız zaman otomatik dolduruyor geri kalanı ihtiyaç olursada veri doğrulama yaparım)
*Sürücü sayfasına isimlerim 15 gibi falan olacak buraya da isimlerinin kullanacağı plakalar yazılı olacak ki asıl istediğimde bu. Ben verileri girerken mesaidata sayfasına tarih araç sürücüsünü yazdığım zaman bana hangi plakayı kullandığını otomatik olarak versin.
*Başlangıc saat kısmınıda şu şekilde açıklamak getirmek isterim, Sürücü! Sayfasında sürücünün plakası asıl istediğim yanında ama ilave örnek olarak 15 kişinin yarısı 06:00 başlayacak diğer yarısıda 08:00 başlayacak. Onun için düşeyara nın iki data getirmesini istedim. BU saat değişikliği aydan aya olacağı için excel giriş saatleri karışmasın diye her ay için ayrı bir excel dosyası kullanacam.(ocak-şubat-mart) gibi.
*b3:b9 ben değiştirdiğimi zannediyordum onun için kusuruma bakmayın evet bütün b: sütununa işlenmesi lazım.
Toparlamak gerekirse tarih yazdım isim yazdım düşeyara ile plaka gelecek ve bu ay kaçta başlayan grup olduğunu belirten saat gelecek, sonra ben bitiş saatini yazacam ve seferini yazıp varsa açıklama satırı bitirecem....

Etamustafa · 17 Şubat 2018

İki tane macro birletirmede sorun yaşamaya devam ediyorum yardımcı edecek bir arkadaş olursa sevinirim.

Ömer BARAN · 17 Şubat 2018

Tekrar merhaba.

Ben sorununuzun giderildiğini sanıyordum.
MESAİDATA sayfasının kod bölümündeki kod'u aşağıdakiyle değiştirerek dener misiniz?
NOT: Önce, SÜRÜCÜ sayfası D sütununa olması gereken verileri yazınız.
.

Kod:

[B]Private Sub Worksheet_Change(ByVal Target As Range)[/B]
sonsat = Cells(Rows.Count, "[B][COLOR="Red"]B[/COLOR][/B]").End(3).Row
alan = "I2:I" & sonsat & ", B2:B" & sonsat
If Intersect(Target, Range(alan)) Is Nothing Then Exit Sub
Set wf = Application.WorksheetFunction
Set m = Sheets("MESAİ"): Set md = Sheets("MESAİDATA"): Set s = Sheets("SÜRÜCÜ")
Application.Calculation = xlCalculationManual
    If Target.Column = 9 Then
[COLOR="SeaGreen"]''*** I SÜTUNU İÇİN ÇALIŞACAK KOD BAŞLANGICI[/COLOR]
        If wf.CountIf(m.[C:C], md.Cells(Target.Row, "B")) = 0 Or _
            wf.CountIf(m.[3:3], md.Cells(Target.Row, "A")) = 0 Then GoTo 10
        sat = wf.Match(md.Cells(Target.Row, "B"), m.[C:C], 0) + 2
        sut = wf.Match(md.Cells(Target.Row, "A"), m.[3:3], 0)
        With m.Cells(sat, sut)
            .ClearComments
            If Target <> "" Then
                .AddComment: .Comment.Text Text:=Target.Text
            End If
        End With
        GoTo 10
[COLOR="seagreen"]''*** I SÜTUNU İÇİN ÇALIŞACAK KOD BİTİŞİ[/COLOR]
    ElseIf Target.Column = 2 Then
[COLOR="seagreen"]''*** B SÜTUNU İÇİN ÇALIŞACAK KOD BAŞLANGICI[/COLOR]
        If wf.CountIf(s.Range("A:A"), Target) > 0 Then
                md.Cells(Target.Row, "C") = wf.VLookup(Target, s.Range("A:E"), 2, 0)
                md.Cells(Target.Row, "D") = wf.VLookup(Target, s.Range("A:E"), 4, 0)
                GoTo 10
[COLOR="seagreen"]''*** B SÜTUNU İÇİN ÇALIŞACAK KOD BİTİŞİ[/COLOR]
        End If
    End If
10: Application.Calculation = xlCalculationAutomatic
[B]End Sub[/B]

Etamustafa · 27 Şubat 2018

Hocam teşekkür ederim, tam istedigim gibi olmuş. Bir daha sıkıntım oldugu zaman, biraz daha anlaşılır bir şekilde aktaracam ki kısa zamanda çözüme kavuşalım.

Ömer BARAN · 27 Şubat 2018

Etamustafa' Alıntı:
Hocam teşekkür ederim, tam istedigim gibi olmuş. Bir daha sıkıntım oldugu zaman, biraz daha anlaşılır bir şekilde aktaracam ki kısa zamanda çözüme kavuşalım.

.
Soru net/anlaşılır
(konuyu/belgeyi/belgenin işleyişini hiç bilmeyen birinin anlamasını sağlayacak netlikte örnek ve açıklamalar içermesi)
olursa birkaç mesaj ile net çözüme ulaşılabilir.

Herneyse, ihtiyaç görüldüğüne göre mesele yok.

İyi çalışmalar, başarılar dilerim.
.

İki vba kodunun birleştirilmesi SORUN!

Etamustafa

Ömer BARAN

Uzman

Etamustafa

Ömer BARAN

Uzman

Etamustafa

Ekli dosyalar

Ömer BARAN

Uzman

Etamustafa

Ekli dosyalar

Ömer BARAN

Uzman

Etamustafa

Etamustafa

Ömer BARAN

Uzman

Etamustafa

Ömer BARAN

Uzman