Sütunlara aktar

[Ahmet Sami]

Kıymetli Üstadlarım, örnek dosyamda ki Kırmızı Renkli olan ADI SOYADI, TARİH kısmını aktar butonuna her tıkladığımda VERİ sayfasında bulacak ve SARI renk ile renklendirdiğim ödeme-1, ödeme-2 .... sütunlara ekleyecek, bu arada diğer bilgilerde herhangi bir değişiklik yapmayacak, sadece AA7 de yer alan 125TL yi I hücresinden itibaren boş olan ilk isim karşılğı olan satıra aktaracak.
Ayrıca VERİ sayfamda yer alan formülleri bozmayacak.

 

[YUSUF44]

Öncelikle dosyanızda Sayfa1'de Ali ALP yazıyorken Sayfa2'de ALİ ALPTEKİN yazıyor. Makronun düzgün çalışması için bunlar aynı olmalıdır.

İkinci olarak Sayfa1'de yıl hücresi yani AA5 hücresindeki veri metin olarak biçimlenmişken Sayfa2'deki yıl sütunu sayı olarak biçimlendirilmiş. Bunu düzeltmek için makroda *1 kullandım.

Aşağıdaki makroyu deneyiniz:

Sub aktar()
Set s1 = Sheets("ANASAYFA")
Set s2 = Sheets("VERİ")
son = s2.Cells(Rows.Count, "C").End(3).Row
For i = 2 To son
    If s2.Cells(i, "C") = s1.[AA3] And s2.Cells(i, "E") = s1.[AA5] * 1 Then
        sut = WorksheetFunction.Max(9, s2.Cells(i, Columns.Count).End(xlToLeft).Column + 1)
        s2.Cells(i, sut) = s1.[AA7]
        i = son
    End If
Next
End Sub

 

[Ahmet Sami]

Yusuf bey çok teşekkür ederim. Birde mesaj olarak "AKTARILDI" ve "tarih ve isim yanlış" gibi Msbox olabilir mi.

 

[YUSUF44]

Aşağıdaki gibi olabilir:

Sub aktar()
Set s1 = Sheets("ANASAYFA")
Set s2 = Sheets("VERİ")
yer = "yok"
son = s2.Cells(Rows.Count, "C").End(3).Row
For i = 2 To son
    If s2.Cells(i, "C") = s1.[AA3] And s2.Cells(i, "E") = s1.[AA5] * 1 Then
        sut = WorksheetFunction.Max(9, s2.Cells(i, Columns.Count).End(xlToLeft).Column + 1)
        s2.Cells(i, sut) = s1.[AA7]
        i = son
        yer = "var"
    End If
Next
If yer = "yok" Then
    MsgBox "VERİ sayfasında " & s1.[AA3] & " adlı kişinin " & s1.[AA5] & " tarihli kaydı bulunmamaktadır!", vbInformation, "Tarih ve/veya isim yanlış!"
Else
    MsgBox "AKTARILDI!", vbInformation
End If
End Sub

 

[Ahmet Sami]

Allah razı olsun çok teşekkür ederim.

 

[Ahmet Sami]

Yusuf hocam ve kıymetli üstadlarım. Yusuf hocamın hazırlamış olduğu bu kodu aktarma işleminde kullanıyorum. Güzel de çalışıyor ve işime yarıyor. Ancak TL cinsinden olan rakamları hücreye aktarırken METİN şeklinde aktarma yaptığı için toplama işlemine dahil olmuyor. Bu kodu ona göre revize edebilirmiyiz. Yani sayı veya para birimi olarak aktarması gerekiyor ki toplama işlemini yapabileyim.

Sub ucret_aktar()
Set s1 = Sheets("ANASAYFA")
Set s2 = Sheets("KAYIT")
yer = "yok"
son = s2.Cells(Rows.Count, "C").End(3).Row
For i = 2 To son
If s2.Cells(i, "C") = s1.[AA3] And s2.Cells(i, "E") = s1.[AA5] * 1 Then
sut = WorksheetFunction.Max(9, s2.Cells(i, Columns.Count).End(xlToLeft).Column + 1)
s2.Cells(i, sut) = s1.[AA6]
i = son
yer = "var"
End If
Next
If yer = "yok" Then
MsgBox "VERİ sayfasında " & s1.[AA3] & " adlı kişinin " & s1.[AA5] & " tarihli kaydı bulunmamaktadır!", vbInformation, "Tarih ve/veya isim yanlış!"
Else
MsgBox "AKTARILDI!", vbInformation
End If
End Sub

 

[Ahmet Sami]

TextBox aktarırken Rakamı metin biçimi olarak aktarıyor. Rakamı rakam olarak aktarması gerekiyor ki topla yapabileyim

 

[YUSUF44]

Benim kodlarımda textboxla ilgili bir düzenleme olmadığı gibi paylaştığınız son dosyanın da verdiğim kodlarla herhangi bir bağlantısı ve hatta eski dosyanızla uzaktan yakından ilgisi bulunmuyor.

Textboxa yazdığınız veri doğrudan hücrede değişiklik yapacaksa neden araya textbox koyuyorsunuz, doğrudan hücreye yazmak daha pratik olmaz mı? Zaten fark ettiğiniz gibi textboxtan hücreye aktarmada bir çok sorunlar oluşacaktır.

İlla textboxtan hücreye aktarmak istiyorum derseniz asıl çalışma dosyanızı örnek olarak paylaşın ki düzenlemeyi ona göre yapalım.

 

[Ahmet Sami]

Buyurun Yusuf hocam

 

[YUSUF44]

Öyle karmaşık bir dosya yapmışsınız ki ne nerden geliyor, nereye nasıl aktarılıyor anlayıncaya kadar epey uğraştım. Klasik userform yerine resim ve form denetim nesneleri kullanmanız işi bayağı zorlaştırıyor.

s2.Cells(i, sut) = s1.[AA6]

yerine

s2.Cells(i, sut) = s1.[AA6] * 1

deneyin.

 

[Ahmet Sami]

Yusuf bey size gerçekten çok zahmet verdim. Allah razı olsun çoooook teşekkür ederim sağolun