• DİKKAT

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

iki kodu birleştirme

TUNCA ERSİN

Altın Üye
Katılım
18 Ağustos 2021
Mesajlar
131
Excel Vers. ve Dili
Office Professional plus 2016 Tr
Altın Üyelik Bitiş Tarihi
18-08-2026
Sy. Hocalarım ;
aşağıdaki iki tane makro kodu nasıl birleştire biliriz. DÖNÜŞ_EVRAK_NO makrosunu Private Sub Worksheet_Change(ByVal Target As Range) makrosunun içine nasıl yerleştire biliriz. Teşekkür ederim.

Sub DÖNÜŞ_EVRAK_NO()
For a = 1 To Cells(5000, 2).End(xlUp).Row
Cells(a, 1) = Format(Cells(a, 2).Value, "DDMMYYhhnn") & "" & Right(Cells(a, 3).Value, 10) & "" & Left(Cells(a, 9).Value, 3)
Next
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [b:b]) Is Nothing Then Exit Sub
If Selection.Count > 1 Then
a = Selection.Rows.Count
b = Selection.Row
For i = b To b + a - 1
Cells(i, "M") = Now
Next
Else
Target.Offset(0, 13) = Date
End If
End Sub
 

Trilenium

Destek Ekibi
Destek Ekibi
Katılım
16 Eylül 2008
Mesajlar
1,290
Excel Vers. ve Dili
Microsoft Office 2019 English
Private Sub Worksheet_Change(ByVal Target As Range)
DÖNÜŞ_EVRAK_NO
End Sub
 

TUNCA ERSİN

Altın Üye
Katılım
18 Ağustos 2021
Mesajlar
131
Excel Vers. ve Dili
Office Professional plus 2016 Tr
Altın Üyelik Bitiş Tarihi
18-08-2026
sy. @Trilenium ;
hocam yapamadım zahmet olmazsa tam yazsanız olur mu ?
 

TUNCA ERSİN

Altın Üye
Katılım
18 Ağustos 2021
Mesajlar
131
Excel Vers. ve Dili
Office Professional plus 2016 Tr
Altın Üyelik Bitiş Tarihi
18-08-2026
sy. @Trilenium ;
hocam şu şekilde yapıldı.
teşekkür ederim ilginizden dolayı

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [b:b]) Is Nothing Then Exit Sub
If Selection.Count > 1 Then
a = Selection.Rows.Count
b = Selection.Row
For i = b To b + a - 1
Cells(i, "M") = Now
For a = 1 To Cells(5000, 2).End(xlUp).Row
Cells(a, 1) = Format(Cells(a, 2).Value, "DDMMhhnn") & "" & Right(Cells(a, 3).Value, 10) & "" & Left(Cells(a, 9).Value, 3)
Next
Next
Else
Target.Offset(0, 13) = Date

End If
End Sub
 

TUNCA ERSİN

Altın Üye
Katılım
18 Ağustos 2021
Mesajlar
131
Excel Vers. ve Dili
Office Professional plus 2016 Tr
Altın Üyelik Bitiş Tarihi
18-08-2026
sy. hocalarım ;
aşağıda ki kodun içine kopyala yapıştır yapınca çalışacak düşeyara eklene bilir mi ?
E sütunu koşuluna göre S sütununda arayacak T sütunundan veriyi alacak L sütununa getirecek U sütunun da arayacak N sütununa getirecek. teşekkür ederim.
236353
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [b:b]) Is Nothing Then Exit Sub
If Selection.Count > 1 Then
a = Selection.Rows.Count
b = Selection.Row
For i = b To b + a - 1
Cells(i, "M") = Now
For a = 1 To Cells(5000, 2).End(xlUp).Row
Cells(a, 1) = Format(Cells(a, 2).Value, "DDMMhhnn") & "" & Right(Cells(a, 3).Value, 10) & "" & Left(Cells(a, 9).Value, 3)
Next
Next
Else
Target.Offset(0, 13) = Date

End If
End Sub
 
Üst