Hücreden Dataya Veri Aktarma (Makro)

Katılım
10 Ağustos 2017
Mesajlar
159
Excel Vers. ve Dili
Excel 2017
Türkçe
Merhaba ,

Ekte yer alan dosyada 10 tane alan var Veri işleme alanı isimli sayfada.

Bu alanlara veri yazdığımda Depolama alanı sayfasına verileri Alan1 - Alan2 yazan sıraya göre kaydetmesini istiyorum.

Bu konuda destek olabilir misiniz?

İyi çalışmalar
 

Ekli dosyalar

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,325
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Deneyiniz.

C++:
Option Explicit

Sub Aktar()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim Son As Long, Nesne As Shape
    
    Set S1 = Sheets("Veri İşleme Alanı")
    Set S2 = Sheets("Depolama Alanı")
    
    Son = S2.Cells(S2.Rows.Count, 2).End(3).Row + 1
    
    For Each Nesne In S1.Shapes
        If InStr(1, Nesne.Name, "TextBox") > 0 Then
            S2.Cells(Son, Val(Replace(Nesne.Name, "TextBox", "")) + 1) = Nesne.DrawingObject.Object.Value
            Nesne.DrawingObject.Object.Value = ""
        End If
    Next
    
    Set S1 = Nothing
    Set S2 = Nothing
    
    MsgBox "Kayıt işlemi tamamlanmıştır.", vbInformation
End Sub
 

veyselemre

Özel Üye
Katılım
9 Mart 2005
Mesajlar
3,553
Excel Vers. ve Dili
Pro Plus 2021
Veri İşleme sayfanızın kod kısmına yapıştırın.

Kod:
Private Sub ToggleButton1_Click()
    Set s2 = Sheets("Depolama Alanı")
    sat = s2.Cells(Rows.Count, 2).End(3).Row + 1
    
    For i = 1 To 10
        s2.Cells(sat, i + 1).Value = ActiveSheet.OLEObjects("Textbox" & i).Object.Text
        
        'Aşağıdaki satır textboxları temizler.
        ActiveSheet.OLEObjects("Textbox" & i).Object.Text = ""
    Next i
End Sub
 
Katılım
10 Ağustos 2017
Mesajlar
159
Excel Vers. ve Dili
Excel 2017
Türkçe
Korhan Bey teşekkür ederim.

Ancak bir soru işareti daha çıktı şimdi. Normalde bilgisayarda tab tuşu ile aşağıdaki hücreye inebiliyoruz burada o gerçekleşmiyor.

Bunun için bir çözüm var mı acaba
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,325
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Siz zor olan yöntemi tercih etmişsiniz. Bu işlem için "Form Controls" nesneleri kullanmışsınız. Bence excel sayfası üzerinden işlem yapacaksanız excel hücrelerini kullanmayı tercih edebilirsiniz. Yönetmesi daha pratik ve kolay olur.

Yok ben bu şekilde nesneler kullanmak istiyorum diyorsanız o zaman UserForm konularını incelemenizi tavsiye ederim.
 
Katılım
10 Ağustos 2017
Mesajlar
159
Excel Vers. ve Dili
Excel 2017
Türkçe
Merhaba ,

Ekte Veri girişi isimli sayfaya veri girdiğimde ve verileri kaydet butonuna bastığımda verileri konu sırasına göre Data isimli sayfaya aktarmasını istiyorum.

Hergün yüzlerce verişi girişi olabiliyor ve data isimli sayfaya sıra bozulmadan veri girişi oldukça alt alta kaydetmesi mümkün mü acaba

Bu konuda yardımcı olabilir misiniz.

İyi çalışmalar
 

Ekli dosyalar

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,325
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Deneyiniz.

C++:
Option Explicit

Sub Verileri_Kaydet()
    Dim S1 As Worksheet, S2 As Worksheet, Son As Long
   
    Set S1 = Sheets("Veri Giriş")
    Set S2 = Sheets("Data")
   
    Son = S2.Cells(S2.Rows.Count, 2).End(3).Row + 1
   
    S2.Cells(Son, "B") = S1.Range("B2").Value
    S2.Cells(Son, "C") = S1.Range("B4").Value
    S2.Cells(Son, "D") = S1.Range("B6").Value
    S2.Cells(Son, "E") = S1.Range("B8").Value
    S2.Cells(Son, "F") = S1.Range("B10").Value
    S2.Cells(Son, "G") = S1.Range("B12").Value
    S2.Cells(Son, "H") = S1.Range("B14").Value
    S2.Cells(Son, "I") = S1.Range("B16").Value
    S2.Cells(Son, "J") = S1.Range("B18").Value
    S2.Cells(Son, "K") = S1.Range("B20").Value
    S2.Cells(Son, "L") = S1.Range("B22").Value
    S2.Cells(Son, "M") = S1.Range("G2").Value
    S2.Cells(Son, "N") = S1.Range("G4").Value
    S2.Cells(Son, "O") = S1.Range("G6").Value
    S2.Cells(Son, "P") = S1.Range("G8").Value
    S2.Cells(Son, "Q") = S1.Range("G10").Value
    S2.Cells(Son, "R") = S1.Range("G12").Value
    S2.Cells(Son, "S") = S1.Range("G14").Value
    S2.Cells(Son, "T") = S1.Range("G16").Value
    S2.Cells(Son, "U") = S1.Range("G18").Value
    S2.Cells(Son, "V") = S1.Range("G20").Value
    S2.Cells(Son, "W") = S1.Range("G22").Value
    S2.Cells(Son, "X") = S1.Range("L2").Value
    S2.Cells(Son, "Y") = S1.Range("L4").Value
    S2.Cells(Son, "Z") = S1.Range("L6").Value
    S2.Cells(Son, "AA") = S1.Range("L8").Value
    S2.Cells(Son, "AB") = S1.Range("L10").Value
    S2.Cells(Son, "AC") = S1.Range("L12").Value
    S2.Cells(Son, "AD") = S1.Range("L14").Value
    S2.Cells(Son, "AE") = S1.Range("L16").Value
    S2.Cells(Son, "AF") = S1.Range("L18").Value
    S2.Cells(Son, "AG") = S1.Range("L20").Value
    S2.Cells(Son, "AH") = S1.Range("L22").Value

    S1.Range("B2:C22").ClearContents
    S1.Range("G2:H22").ClearContents
    S1.Range("L2:M22").ClearContents

    Set S1 = Nothing
    Set S2 = Nothing

    MsgBox "Kayıt işlemi tamamlanmıştır.", vbInformation
End Sub
 
Katılım
10 Ağustos 2017
Mesajlar
159
Excel Vers. ve Dili
Excel 2017
Türkçe
Teşekkür Ederim Korhan Bey.

İyi çalışmalar
 

veyselemre

Özel Üye
Katılım
9 Mart 2005
Mesajlar
3,553
Excel Vers. ve Dili
Pro Plus 2021
Kod:
Sub test()
    
    Dim lRow&, fCol%, cl%, rw%
    lRow = Sheets("Data").Cells(Rows.Count, 2).End(3).Row + 1
    
    For cl = 4 To 14 Step 5
        fCol = (((cl + 1) / 5) - 1) * 11 + 1
        For rw = 2 To 22 Step 2
            Sheets("Data").Cells(lRow, fCol + (rw / 2)).Value = Sheets("Veri Giriş").Cells(rw, cl).Value
        Next rw
    Next cl
    
    Sheets("Veri Giriş").Range("D2:E22,I2:J22,N2:O22").ClearContents
    MsgBox "Kayıt işlemi tamamlanmıştır.", vbInformation
    
End Sub
 
Son düzenleme:
Katılım
10 Ağustos 2017
Mesajlar
159
Excel Vers. ve Dili
Excel 2017
Türkçe
Merhaba ,

Ekte açılır pencere ile kayıt ekranı var. Ancak verileri kaydet butonunu aktifleştiremedim.

Açılır pencereye kaydettiğim verilerin otomatik data sayfasına alt alta kaydetmesi için yardımcı olabilir misiniz

İyi çalışmalar
 

Ekli dosyalar

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,325
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Önce Userform üzerindeki TextBox nesnelerini numerik olarak sıralı şekilde düzenleyin. Nasıl yapacağım derseniz. Formu kod editöründe açtığınızda TextBox2 nesnesinden sonra TextBox4 geliyor. Bunu sıralı olacak şekilde düzenlemelisiniz.

Sonra aşağıdaki kodu problemsiz kullanabilirsiniz.

C++:
Private Sub CommandButton1_Click()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim Son As Long, X As Byte
    
    Set S1 = Sheets("Veri Giriş")
    Set S2 = Sheets("Data")
    
    Son = S2.Cells(S2.Rows.Count, 2).End(3).Row + 1
    
    For X = 1 To 24
        S2.Cells(Son, X + 1) = Me.Controls("TextBox" & X).Value
        Me.Controls("TextBox" & X).Value = ""
    Next
    
    Set S1 = Nothing
    Set S2 = Nothing
    
    MsgBox "Kayıt işlemi tamamlanmıştır.", vbInformation
End Sub
 
Katılım
10 Ağustos 2017
Mesajlar
159
Excel Vers. ve Dili
Excel 2017
Türkçe
Teşekkür ederim Korhan Bey ,

Emeğinize sağlık elleriniz dert görmesin
 
Katılım
10 Ağustos 2017
Mesajlar
159
Excel Vers. ve Dili
Excel 2017
Türkçe
Korhan Bey Merhaba ,

Ekte bazı değişmler yapmam gerekti. Texbox'lar varken verdiğiniz kodlar ile istediğim olmuştu ancak combobox'lar eklemek zorunda kaldım.

Combobox'lardan sonra kayıt işlemi gerçekleşmiyor.

Hem Combobox hemde textboxları aynı anda kaydedebilmem için yardımcı olmanız mümkün mü acaba ?

İyi çalışmalar
 

Ekli dosyalar

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,325
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Önerdiğim yapıyı kullanabilmeniz için nesnelerin isimlerini değiştirmemeniz gerekir.

Son paylaştığınız dosyada nesnelerin bazılarının isimlerini değiştirmişsiniz. Böyle bir yapıda ortak kodlama yazmanın pek bir esprisi kalmaz.

4 satır For-Next döngüsü ile halledilen kayıt işlemi nesne sayısı kadar uzamak zorunda kalacaktır.

Böyle kullanmak istiyorsanız satır satır kayıt işlemini yapmanız gerekir.

Aşağıdaki döngü satırlarını kaldırın;

C++:
    For X = 1 To 24
        S2.Cells(Son, X + 1) = Me.Controls("TextBox" & X).Value
        Me.Controls("TextBox" & X).Value = ""
    Next
Yerine aşağıdaki satırları nesnelere göre yazarak çoğaltın. İki satır için örnek veriyorum. Siz formunuzdaki nesne isimlerine göre gerisini kendiniz yazarsınız. Yani #7-8 nolu mesajımda ki gibi bir yapı kurmanız gerekiyor.

C++:
    S2.Cells(Son, 2) = Me.TextBox1.Value
    S2.Cells(Son, 3) = Me.ComboBox1.Value
    'Diğer nesneleri altına yazarak çoğaltınız...
 
Katılım
10 Ağustos 2017
Mesajlar
159
Excel Vers. ve Dili
Excel 2017
Türkçe
Teşekkür ederim Korhan Bey

İyi çalışmalar
 
Üst