• DİKKAT

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

veri birleştirip yazdırma

ismailozkan4224

Altın Üye
Katılım
22 Kasım 2011
Mesajlar
175
Excel Vers. ve Dili
2007 türkçe
değerli arkadaşlar aşağıdaki kod ile verilerimi yazdırabiliyorum. ancak iki çizgi arasındaki " kırmızı renkteki kod " koda çözüm bulamadım. yapmak istediğim hangi satırın 3. sütununa veri girilirse o satırın 2. ve 3. sütunu birleştirip 4. sütuna yazacak. yardım ederseniz sevinirim. teşekkürler.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
' OTOMATİK OLARAK 1. SATIRDAN 9.SÜTUN VE 10. SÜTUNDAKİ VERİLERİ AD VE AE SÜTUNUNA YAZAR
On Error GoTo son

If Intersect(Target, [C:C]) Is Nothing Then Exit Sub
Cells(Target.Row, "AD:AD") = Cells(1, 11)
Cells(Target.Row, "AE:AE") = Cells(1, 12)
Cells(Target.Row, "G:G") = Cells(1, 3)
Cells(Target.Row, "E:E") = Cells(1, 9) & " " & Cells(1, 10)


Varsayılan veri birleştirip yazdırma
değerli arkadaşlar aşağıdaki kod ile verilerimi yazdırabiliyorum. ancak iki çizgi arasındaki " kırmızı renkteki kod " koda çözüm bulamadım. yapmak istediğim hangi satırın 3. sütununa veri girilirse o satırın 2. ve 3. sütunu birleştirip 4. sütuna yazacak. yardım ederseniz sevinirim. teşekkürler.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
' OTOMATİK OLARAK 1. SATIRDAN 9.SÜTUN VE 10. SÜTUNDAKİ VERİLERİ AD VE AE SÜTUNUNA YAZAR
On Error GoTo son

If Intersect(Target, [C:C]) Is Nothing Then Exit Sub
Cells(Target.Row, "AD:AD") = Cells(1, 11)
Cells(Target.Row, "AE:AE") = Cells(1, 12)
Cells(Target.Row, "G:G") = Cells(1, 3)
Cells(Target.Row, "E:E") = Cells(1, 9) & " " & Cells(1, 10)

'----------------------------------------------------------------------
Cells(Target.Row, "D : D") = Cells(3, 2) & " " & Cells(3, 3)
'----------------------------------------------------------------------

Cells(Target.Row, "P:P") = Cells(1, 16)
Cells(Target.Row, "R:R") = Cells(1, 18)
Cells(Target.Row, "V:V") = Cells(1, 22)
Cells(Target.Row, "W:W") = Cells(1, 23)
Cells(Target.Row, "X:X") = Cells(1, 24)
Cells(Target.Row, "Y:Y") = Cells(1, 25)
Cells(Target.Row, "Z:Z") = Cells(1, 26)
Cells(Target.Row, "AA:AA") = Cells(1, 27)
son:

' OTOMATİK OLARAK B SÜTUNUNA VERİ GİRİLDİĞİNDE SIRA NUMARASI VERİR

If Target.Column <> 3 Then Exit Sub
If Target.Row = 2 Then Exit Sub
If Left(Target.Offset(0, -1), 1) = "~" Then Exit Sub
If Left(Target.Offset(0, -1), 1) = "~" Then Exit Sub
If Left(Target.Offset(0, -1), 1) = "=Row()-3" Then Exit Sub
Target.Offset(0, -2).Formula = "=Row()-3+1"

End Sub
 
Son düzenleme:
Kod:
Cells(Target.Row, "D : D") = Cells(3, 2) & " " & Cells(3, 3)

Yukardaki satırı aşağıdaki gibi değiştirin:

Kod:
Cells(Target.Row, "D") = Cells(Target.Row, 2) & " " & Cells(Target.Row, 3)

Ya da şöyle:
Kod:
Cells(Target.Row, "D") = Cells(Target.Row, "B") & " " & Cells(Target.Row, "C")

Ya da şöyle:

Kod:
Target.Offset(0,1) = Target.Offset(0,-1) & " " & Target

Farklı çözümler de bulunabilir.
 
Geri
Üst