- Katılım
- 25 Mayıs 2010
- Mesajlar
- 480
- Excel Vers. ve Dili
-
Office 2019
64bit
Tr
Win 10
- Altın Üyelik Bitiş Tarihi
- 12-07-2024
Merhaba Sn. Yetkililer,
TUM PERSONEL sayfasında bulunan Artiİşareti Makrosunun altına Makro Kaydet yöntemiyle eklediğim TumPersonelFormulleri kodunu + butonu ile birlikte çalıştırabilir miyim?
TUM PERSONEL sayfasında bulunan Artiİşareti Makrosunun altına Makro Kaydet yöntemiyle eklediğim TumPersonelFormulleri kodunu + butonu ile birlikte çalıştırabilir miyim?
Kod:
Sub Artıİşareti1_Tıkla()
Dim tum As Worksheet, brd As Worksheet
Set brd = Sheets("BORDRO")
Set tum = Sheets("TUM_PERSONEL")
son1 = tum.Cells(Rows.Count, "A").End(3).Row + 1 'tüm
son2 = brd.Cells(Rows.Count, "A").End(3).Row 'brd
sayi = 0
For i = 11 To son2
If brd.Cells(i, "A") > "" Then
ArananTc = brd.Cells(i + 1, "B")
say = WorksheetFunction.CountIf(tum.Range("B4:B" & son1 - 1), ArananTc)
If say = 0 Then
tum.Cells(son1, "A") = Val(tum.Cells(son1 - 1, "A")) + 1
tum.Cells(son1, "B") = brd.Cells(i + 1, "B")
tum.Cells(son1, "C") = brd.Cells(i, "B")
tum.Cells(son1, "J") = brd.Cells(i, "D")
tum.Cells(son1, "K") = brd.Cells(i + 1, "D")
son1 = son1 + 1
sayi = sayi + 1
End If
End If
Next i
If sayi > 0 Then
MsgBox sayi & " Yeni Personel Eklenmiştir."
Else
MsgBox "Yeni Personel Yoktur."
End If
End Sub
Sub TumPersonelFormulleri()
'
' TumPersonelFormulleri Makro
'
'
Range("D4").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(VLOOKUP(RC[-2],PERSONEL_LISTESI!C[-2]:C,3,0),"""")"
Range("D4").Select
Selection.AutoFill Destination:=Range("D4:D999")
Range("D4:D999").Select
Range("G4").Select
ActiveCell.FormulaR1C1 = _
"=IF(MID(RC[5],3,5)=""00012"",IF(LEFT(MID(SUBSTITUTE(RC[5],RIGHT(RC[5],11),""""),10,99)+0,1)=""9"",MID(MID(SUBSTITUTE(RC[5],RIGHT(RC[5],11),""""),10,99)+0,2,99),MID(SUBSTITUTE(RC[5],RIGHT(RC[5],11),""""),10,99)+0)+0,"""")"
Range("G4").Select
Selection.AutoFill Destination:=Range("G4:G999")
Range("G4:G999").Select
Range("H4").Select
ActiveCell.FormulaR1C1 = "=IF(MID(RC[4],3,5)=""00012"",RIGHT(RC[4],8),"""")"
Range("H4").Select
Selection.AutoFill Destination:=Range("H4:H999")
Range("H4:H999").Select
End Sub
Ekli dosyalar
-
283.5 KB Görüntüleme: 5