Skip to main content

AccessTr.neT


D Hücresindeki Sayı Kadar E Hücresine Yazdırma

D Hücresindeki Sayı Kadar E Hücresine Yazdırma

Çözüldü #1
Sayın Hocalarım merhaba,

ekli örnekte d hücresine yazılan sayı kadar (d7 hücresinde görüleceği gibi) e hücresine 01, 02 , 03 gibi d hücresindeki sayı kadar satır eklemesi.


Saygılarımla,
.rar Kitap.rar (Dosya Boyutu: 6,51 KB | İndirme Sayısı: 1)
Ahmet Yenginoğlu
Cevapla
#2
Aynı hücre içine mi Sayın @yenginoglu
Cevapla
#3
Hocam yan hücreye
Ahmet Yenginoğlu
Cevapla
#4
Ben örneğin D3 hücresine veri girdiğinizde E3 hücresinde mi istediğiniz kadar satır oluşturulacak anlamında sormuştum ama örneğinizden yola çıkarak E sütununda satır oluşturmak gerektiğini yorumladım. Bu minvalde
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Dim LastRow As Long, RowCount As Integer, i As Integer, FirmValue As String
   
    Set ws = ThisWorkbook.Sheets(1) 'Hangi sayfa üzerinde işlem yapıyorsanız ona göre düzenleyin
   
    'Sadece D sütunundaki değişikliklere tepki ver
    If Not Intersect(Target, ws.Columns("D")) Is Nothing Then
        Application.EnableEvents = False
       
        For Each cell In Target    'D'de değişiklik varsa döngüye gir
            If cell.Value <> "" Then
                RowCount = cell.Value    'D sütunundaki sayı al
                FirmValue = ws.Cells(cell.Row, "A").Value    'A sütunundaki firma adını al
                LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row  'Son satırı belirle
               
                'Yeni satır ve değer ekleme işlemleri için alt döngüye gir
                For i = 1 To RowCount
                    With ws
                        .Cells(LastRow, "A").Value = FirmValue    'A sütununa firma adını yaz
                        .Cells(LastRow, "E").Value = Format(i, "00")    'E sütununa D'ye göre 01, 02 gibi değerleri yaz
                        .Cells(LastRow, "F").Value = FirmValue & "-KLP-" & .Cells(LastRow, "E").Value    'F sütununu doldur
                    End With
                    LastRow = LastRow + 1
                Next i
            End If
        Next cell
        Cells(LastRow, 1).Select   'İlk boş A hücresini seç
        Application.EnableEvents = True
    End If
End Sub
kodu işinizi görecektir. Bu koda göre veri girişi yaptığınızda D sütununda sayısal bir değer girdiğinizde otomatik olarak istediğiniz alt satırları oluşturacaktır. Kodlarda neyin ne işlem yaptığını mümkün olduğu kadar commentlar ile belirttim siz ihtiyacınız doğrultusunda çalışmanıza uyarlayabilirsiniz, belirli değişiklikleri çok rahat yapabilecek seviyedesiniz zaten.
Cevapla
#5
Hocam çok teşekkür ederim. Sağolun. Gün içerisinde kontrol edip size bilgi vereceğim.

Saygılarımla,
Ahmet Yenginoğlu
Cevapla
#6
Hocam evet istediğim gibi çalışıyor. Çok teşekkür ederim. Sağlıkla kalın.

Saygılarımla,
Ahmet Yenginoğlu
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da