Kod Düzenlenmesinde Yardım

VBA Makrolar ile ilgili sormak istedikleriniz, yapmak istedikleriniz hakkında yardım alabileceğiniz bölümdür.

Kod Düzenlenmesinde Yardım

İleti#1)  CENGİZHANTAHA » 18 Kas 2021 14:16

Öncelikle tüm arkadaşlarıma kolay gelsin.
Girilecek değere göre sütundaki veriyi aktarma konusunda yardımcı olabilir misiniz?
Dosya Ek'tedir. Şimdiden teşekkürler.
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
CENGİZHANTAHA
Yeni Başlamış
 
Kayıt: 20 Kas 2018 11:29
Meslek: EMEKLİ
Yaş: 50
İleti: 86
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: SAKARYA

Cevap: Kod Düzenlenmesinde Yardım

İleti#2)  Ömer BARAN » 18 Kas 2021 16:02

Merhaba @CENGİZHANTANA

Alt taraftan işlem yapılacak Sayfa1'in adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçin,
karşınıza gelecek VBA ekranında sağdaki alana aşağıdaki kodu yapıştırın.

Artık B3 hücresine yazacağınız sayıya göre gerekli aktarma yapılacaktır.

Kod: Tümünü seç
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B3]) Is Nothing Then Exit Sub
Range("B5:B" & Rows.Count).ClearContents
If Target.Value <> "" And IsNumeric(Target.Value) Then
    son = Cells(Rows.Count, Target.Value + 3).End(3).Row
    If son > 4 Then
        [B5].Resize(son - 4, 1).Value = Cells(5, Target.Value + 3).Resize(son - 4, 1).Value
    Else: MsgBox Mid(Cells(1, Target.Value + 3).Address(0, 0), 1, 1) & " sütununda aktarılacak veri yok!", vbCritical
    End If
Else
    MsgBox "B3 hücresine SAYI yazarak sonuç alabilirsiniz.!", vbCritical
End If: Target.Activate
End Sub

.
☾✭ İnadına TÜRKÇE ✭☽

Sorularınızı bana https://www.ExcelDestek.Com 'dan da sorabilirsiniz.



.



.
Kullanıcı avatarı
Ömer BARAN
Siteye Alışmış
 
Adı Soyadı:ÖMER BARAN
Kayıt: 29 Oca 2013 18:17
Konum: ANKARA
Meslek: EMEKLİ
Yaş: 57
İleti: 354
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: ANKARA / ÇANKAYA

Cevap: Kod Düzenlenmesinde Yardım

İleti#3)  CENGİZHANTAHA » 19 Kas 2021 10:29

İlginize teşekkür ederim. Kod hata verdi yardım edermisiniz ?
Kullanıcı avatarı
CENGİZHANTAHA
Yeni Başlamış
 
Kayıt: 20 Kas 2018 11:29
Meslek: EMEKLİ
Yaş: 50
İleti: 86
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: SAKARYA

Cevap: Kod Düzenlenmesinde Yardım

İleti#4)  CENGİZHANTAHA » 19 Kas 2021 10:33

Dosya ektedir.
KATALOG.rar
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
CENGİZHANTAHA
Yeni Başlamış
 
Kayıt: 20 Kas 2018 11:29
Meslek: EMEKLİ
Yaş: 50
İleti: 86
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: SAKARYA

REKLAM
Excel Logo XML Oluşturucu
Logo Object Designer ile Uyarlama

Cevap: Kod Düzenlenmesinde Yardım

İleti#5)  Ömer BARAN » 19 Kas 2021 13:03

@CENGİZHANTAHA.

Aynı sayfa için 1'den fazla Worksheet_Change kodu olduğu için hata alıyorsunuz.
Bu nedenle; MALZEMELER sayfasının kod bölümünde mevcut kodların tümünü silip, yerine aşağıdakini yapıştırın.
Yani iki kodu birleştirmiş oldum, hem resim ekleme işlemleriniz eskisi gibi çalışır,
hem de G3'e sayı yazınca istenilen işlemler gerçekleşir.

Kod: Tümünü seç
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A:A, G3")) Is Nothing Then Exit Sub
If Target.Address = "$G$3" Then
    Range("G5:G" & Rows.Count).ClearContents
    If Target.Value <> "" And IsNumeric(Target.Value) Then
        son = Cells(Rows.Count, Target.Value + 8).End(3).Row
        If son > 4 Then
            [G5].Resize(son - 4, 1).Value = Cells(5, Target.Value + 8).Resize(son - 4, 1).Value
        Else: MsgBox Mid(Cells(1, Target.Value + 8).Address(0, 0), 1, 1) & " sütununda aktarılacak veri yok!", vbCritical
        End If
    Else
        MsgBox "G3 hücresine SAYI yazarak sonuç alabilirsiniz.!", vbCritical
    End If: Target.Activate
Else
    If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
    On Error GoTo çıkış
    ActiveSheet.DrawingObjects.Delete
    Dim ResimYolu As Variant
    Dim Resim As Object
    son = Cells(Rows.Count, 1).End(xlUp).Row
    For satır = 5 To son
        ResimYolu = ActiveWorkbook.Path & "\" & Range("a" & satır) & ".Jpg"
        Set Resim = ActiveSheet.Pictures.Insert(ResimYolu)
        With Range("f" & satır)
            Resim.Top = 20: Resim.Left = 20: Resim.Height = 20: Resim.Width = 20
            Resim.Top = .Top: Resim.Left = .Left: Resim.Height = .Height: Resim.Width = .Width
        End With
    Next satır
çıkış:
End If
End Sub
☾✭ İnadına TÜRKÇE ✭☽

Sorularınızı bana https://www.ExcelDestek.Com 'dan da sorabilirsiniz.



.



.
Kullanıcı avatarı
Ömer BARAN
Siteye Alışmış
 
Adı Soyadı:ÖMER BARAN
Kayıt: 29 Oca 2013 18:17
Konum: ANKARA
Meslek: EMEKLİ
Yaş: 57
İleti: 354
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: ANKARA / ÇANKAYA

Cevap: Kod Düzenlenmesinde Yardım

İleti#6)  CENGİZHANTAHA » 19 Kas 2021 13:18

Ellerinize sağlık Ömer bey, teşekkür ederim. Kolay gelsin.
Kullanıcı avatarı
CENGİZHANTAHA
Yeni Başlamış
 
Kayıt: 20 Kas 2018 11:29
Meslek: EMEKLİ
Yaş: 50
İleti: 86
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: SAKARYA

REKLAM
ETA - Excel Konsolide Raporlama
ETA Excel Personel Entegre Raporu

Forum Genel Makro Soruları

Online Kullanıcılar

Bu forumu görüntüleyenler: AhrefsBot ve 4 misafir

Bumerang - Yazarkafe