Bir kayıt için döngü ile türe bağlı olarak 12/24 satır oluşturmak

meleklerim

Altın Üye
Katılım
2 Ekim 2013
Mesajlar
336
Excel Vers. ve Dili
ofis 2019 türkçe
windows 10 pro türkçe
Altın Üyelik Bitiş Tarihi
23-07-2025
Ekte basit br modelini gönderdiğim user formda verileri türe göre kaydetmek istiyorum.
A türünü seçersem aynı kişiye 12 satır (ay isimlerini sayfadan çektiği)
B türünü seçersem aynı kişiye 24 satır (A için 12 ay B için 12 olmak üzere)
kaydetmesini istiyorum.
Aynı girişleri yapıp id +1 diyerek aynı satırları ayları değiştirerek 24 kez yazmak dışında bir çözüm bulamadım
Ancak gerçek programda 15 sütun olduğu için kaydet makrosu çok uzun oldu.,
daha kısa döngü oluşturarak yapılabilir mi?

örnek dosya ve açıklamalar ekte.
yardımcı oalcak arkadaşlara şimdiden teşekkürler
 

Ekli dosyalar

walabi

Altın Üye
Katılım
22 Eylül 2012
Mesajlar
641
Excel Vers. ve Dili
excel 2010

excel 2013
Altın Üyelik Bitiş Tarihi
06-08-2025
Ekteki dosyayı deneyin. Userform üzerine birkaç ekleme yaptım.
 

Ekli dosyalar

tamer42

Destek Ekibi
Destek Ekibi
Katılım
11 Mart 2005
Mesajlar
3,061
Excel Vers. ve Dili
Office 2013 İngilizce
Ekte basit br modelini gönderdiğim user formda verileri türe göre kaydetmek istiyorum.
A türünü seçersem aynı kişiye 12 satır (ay isimlerini sayfadan çektiği)
B türünü seçersem aynı kişiye 24 satır (A için 12 ay B için 12 olmak üzere)
kaydetmesini istiyorum.
Aynı girişleri yapıp id +1 diyerek aynı satırları ayları değiştirerek 24 kez yazmak dışında bir çözüm bulamadım
Ancak gerçek programda 15 sütun olduğu için kaydet makrosu çok uzun oldu.,
daha kısa döngü oluşturarak yapılabilir mi?

örnek dosya ve açıklamalar ekte.
yardımcı oalcak arkadaşlara şimdiden teşekkürler
Merhaba,
Bu şekilde bir çözüm bekliyordunuz?

Kod:
Private Sub CommandButton1_Click()
Dim SH As Worksheet
Dim SHT As Worksheet
Dim ad As String
Dim soyad As String
Dim rw As Long
Dim i As Long
Dim m As Long
Dim r As Integer
Dim d As Integer


Set SH = Sayfa1
Set SHT = Sayfa2


With SH
    rw = .Cells(.Rows.Count, "A").End(xlUp).Row
End With

m = Application.WorksheetFunction.Max(SH.Range("A2:A" & rw))

If Me.TextBox1 = "" Then
    MsgBox "Ad Soyad bilgisini giriniz!", vbExclamation, "Uyarı"
    Exit Sub
End If

If Me.TextBox2 = "" Then
    MsgBox "Tür bilgisini giriniz!", vbExclamation, "Uyarı"
    Exit Sub
End If

If Me.TextBox2 = "A" Then
    d = 12
ElseIf Me.TextBox2 = "B" Then
    d = 24
Else
    Exit Sub
End If

If InStr(1, Me.TextBox1, " ") > 0 Then
    ad = Split(Me.TextBox1, " ")(0)
    soyad = Split(Me.TextBox1, " ")(1)
Else
    ad = Me.TextBox1
End If


r = 1

For i = 1 To d
     SH.Cells(rw + i, 1) = m + 1
     SH.Cells(rw + i, 2) = ad
     SH.Cells(rw + i, 3) = soyad
     SH.Cells(rw + i, 4) = Me.TextBox2
     SH.Cells(rw + i, 5) = SHT.Cells(r + 1, 2)
     r = r + 1
     If r = 13 Then r = 1
Next i

MsgBox "İşlem Tamam"

End Sub
[CODE]
 

meleklerim

Altın Üye
Katılım
2 Ekim 2013
Mesajlar
336
Excel Vers. ve Dili
ofis 2019 türkçe
windows 10 pro türkçe
Altın Üyelik Bitiş Tarihi
23-07-2025
Ekteki dosyayı deneyin. Userform üzerine birkaç ekleme yaptım.
hocam teşekkürler yardımınız için
1) ancak ayları almıyor.
2) aynı kayıtttan aynı numaralı 12/24 kayıt açıyor. Benim istediğim kayıtlar aylar dışında aynı olsa da A sütünuna farklı sayı vermesi (ID)
3) Enterasan bir şekilde data tablosunda ikinci satır boşken çalışmıyor. (1. satırda zaten sütun başlıkları var) ama ikinci satır doluyken çalışıyor.
 

meleklerim

Altın Üye
Katılım
2 Ekim 2013
Mesajlar
336
Excel Vers. ve Dili
ofis 2019 türkçe
windows 10 pro türkçe
Altın Üyelik Bitiş Tarihi
23-07-2025
Merhaba,
Bu şekilde bir çözüm bekliyordunuz?

Kod:
Private Sub CommandButton1_Click()
Dim SH As Worksheet
Dim SHT As Worksheet
Dim ad As String
Dim soyad As String
Dim rw As Long
Dim i As Long
Dim m As Long
Dim r As Integer
Dim d As Integer


Set SH = Sayfa1
Set SHT = Sayfa2


With SH
    rw = .Cells(.Rows.Count, "A").End(xlUp).Row
End With

m = Application.WorksheetFunction.Max(SH.Range("A2:A" & rw))

If Me.TextBox1 = "" Then
    MsgBox "Ad Soyad bilgisini giriniz!", vbExclamation, "Uyarı"
    Exit Sub
End If

If Me.TextBox2 = "" Then
    MsgBox "Tür bilgisini giriniz!", vbExclamation, "Uyarı"
    Exit Sub
End If

If Me.TextBox2 = "A" Then
    d = 12
ElseIf Me.TextBox2 = "B" Then
    d = 24
Else
    Exit Sub
End If

If InStr(1, Me.TextBox1, " ") > 0 Then
    ad = Split(Me.TextBox1, " ")(0)
    soyad = Split(Me.TextBox1, " ")(1)
Else
    ad = Me.TextBox1
End If


r = 1

For i = 1 To d
     SH.Cells(rw + i, 1) = m + 1
     SH.Cells(rw + i, 2) = ad
     SH.Cells(rw + i, 3) = soyad
     SH.Cells(rw + i, 4) = Me.TextBox2
     SH.Cells(rw + i, 5) = SHT.Cells(r + 1, 2)
     r = r + 1
     If r = 13 Then r = 1
Next i

MsgBox "İşlem Tamam"

End Sub
[CODE]

Hocam teşekkürler yardımlarınız için ancak
1- ad soyad kısmını birleşik girip sonra tabloda kesmek bazı hatalı girişlere neden olabiliyor. (örneğin 3 ve fazlası isimlerde sadece ilk iki kelimeyi alıyor.
2. A sütununa hep aynı sayıyı atıyor +1 yapması lazım
 

walabi

Altın Üye
Katılım
22 Eylül 2012
Mesajlar
641
Excel Vers. ve Dili
excel 2010

excel 2013
Altın Üyelik Bitiş Tarihi
06-08-2025
Sayım tamer42 nin kodları benim gönderdiklerime göre daha uygun. Ancak userform üzerine isim, soyisim ve tür için 3 ayrı textbox oluşturularak tekrardan derlenmeli kodları.

Ve şunu anlamadım. örneğin 12 lik tür için 1,2,3......12 olacak, 24 lük tür için 1,2,3..... 24 şeklinde olacak satır nolarının olmasını mı istiyorsunuz.
 

meleklerim

Altın Üye
Katılım
2 Ekim 2013
Mesajlar
336
Excel Vers. ve Dili
ofis 2019 türkçe
windows 10 pro türkçe
Altın Üyelik Bitiş Tarihi
23-07-2025
Sayım tamer42 nin kodları benim gönderdiklerime göre daha uygun. Ancak userform üzerine isim, soyisim ve tür için 3 ayrı textbox oluşturularak tekrardan derlenmeli kodları.

Ve şunu anlamadım. örneğin 12 lik tür için 1,2,3......12 olacak, 24 lük tür için 1,2,3..... 24 şeklinde olacak satır nolarının olmasını mı istiyorsunuz.
tablo 12 lü tür için A(satırno) B(adı) C(soyadı) D (aylar)
1 ali veli A EYLÜL; 2 ali veli A EKİM; ...... 12 ali veli AĞUSTOS

tablo 24 Lü tür için A(satırno) B(adı) C(soyadı) D (aylar)
İki kere 12 li türü döndürecek.
ekteki dosyamında içinde vardı ama iki örnek kayıt oluşturduğum ekteki dosyaya da bakabilrisiniz
 

Ekli dosyalar

meleklerim

Altın Üye
Katılım
2 Ekim 2013
Mesajlar
336
Excel Vers. ve Dili
ofis 2019 türkçe
windows 10 pro türkçe
Altın Üyelik Bitiş Tarihi
23-07-2025
Sayın tamer42 nin kodlarında birkaç değişiklik yaptım. kontrol ediniz.
hocam çok teşekkürler, tam istediğim gibi yapmışsınız. Kendime de uyarlayabildim.
Yanlız farkettim ki ben bir koşulu hatalı vermişim. Kusura bakmayın.
A türünü seçersek aynı kayda farklı satır numarası ile 12 satır açıyor her bir satırda farklı ay vererek
bu çok güzel çalışıyor
B türünü seçersek aynı kayda farklı satır numarası ile 24 satır açıyor buraya kadar normal ilk 12 satıra farklı ay girdikten sonra tekrar başa dönüp kalan 12 satıra yine farklı ay veriyor.

benim istediğim
B türünü seçtiğimde 12 satır A Türü olarak doldurması kalan 12 satırı B türü olarak doldurması

karışık görünüyor ama ekteki tabloya bakarsanız ne demek istediğimi daha iyi anlatmış olacağım.
 

Ekli dosyalar

meleklerim

Altın Üye
Katılım
2 Ekim 2013
Mesajlar
336
Excel Vers. ve Dili
ofis 2019 türkçe
windows 10 pro türkçe
Altın Üyelik Bitiş Tarihi
23-07-2025
teşekkrüler elinize sağlık. Kayıt güncellemede seçili satırın değeri için "m" değişkeni mi referans göstereceğim?
 

walabi

Altın Üye
Katılım
22 Eylül 2012
Mesajlar
641
Excel Vers. ve Dili
excel 2010

excel 2013
Altın Üyelik Bitiş Tarihi
06-08-2025
Koddaki m satır numarası vermekte. Güncellemekten kastınız nedir. Tam anlamadım sorunuzu.
 

meleklerim

Altın Üye
Katılım
2 Ekim 2013
Mesajlar
336
Excel Vers. ve Dili
ofis 2019 türkçe
windows 10 pro türkçe
Altın Üyelik Bitiş Tarihi
23-07-2025
Yani ilerde mevcut kayıt bilgilerinde örneğin ad soyad vs güncelleme yapılırken, listeden kayıt seçtiğimizde seçilecek satır sayısı için "m" değerine mi bakmalıyız? Onu demek istemiştim.
 
Üst