• DİKKAT

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

Userformdaki bağlı bulunduğu tutarları aktarılması

1903emre34@gmail.com

Altın Üye
Katılım
29 Mayıs 2016
Mesajlar
946
Excel Vers. ve Dili
Microsoft Excel 2013 Türkçe
Merhaba,

Userformdaki verileri seçiyoruz, seçtikten sonra "TAMAM" seçeneği bastığımız zaman, sayfa2'de bulup tutarları Anasayfada yanına aktarılmasını istiyorum,

Geçici Vergi Matrahı olan çerceve olan kısmı tutarları (A50:A60 hücre aralığı) hem "B" sütündadır, diğer verilerin yanındaki tutarlar birleşikdir
 

Ekli dosyalar

Merhaba,

Ana sayfasındaki verilere göre getirilen tutarlar.

Kod:
Set s1 = Worksheets("AnaSayfa")
Set s2 = Worksheets("Sayfa2")
a = s2.[A2:B60]
ReDim b(1 To UBound(a), 1 To 2)
    For i = 1 To UBound(a)
        
        If a(i, 1) <> "" Then
        say = say + 1
            deg = Split(Trim(a(i, 1)), " ")
            If IsNumeric(deg(UBound(deg))) Then
                b(say, 1) = Mid(a(i, 1), 1, Len(a(i, 1)) - 1 - Len(deg(UBound(deg))))
                b(say, 2) = deg(UBound(deg)) * 1
            Else
                b(say, 1) = a(i, 1)
                b(say, 2) = a(i, 2)
            End If
        End If
    Next i

Set d = CreateObject("scripting.dictionary")
    For i = 1 To UBound(a)
        d(Trim(b(i, 1))) = b(i, 2)
    Next i

c = s1.[A24:A51]
ReDim k(1 To UBound(c), 1 To 1)
    For i = 1 To UBound(c)
        k(i, 1) = d(Trim(c(i, 1))) * 1
    Next i

s1.[B24].Resize(UBound(c)) = k
s1.[B24].Resize(UBound(c)).NumberFormat = "#,##0.00"
MsgBox "İşlem tamam.", vbInformation
 

Ekli dosyalar

Teşekkürler, ellerinize sağlık, tutarları sayfa2'den anasayfa aktarırken 10,000,000.00 şeklinde aktarıyor, aşağıdaki şeklinde aktarması kodlarda değişiklik yapamiliryiz

10.000.000,00
 
Geri
Üst