Makro yardımı, veri çekme, tarih ile ilgili YARDIM

[metince54]

Merhaba arkadaşlar. excel dosyasında açıklamalar ekledim. basit bir arıza kayıt listesi oluşturacam 6 çeşit arıza kaydım var. bunların arıza kayıt tarihi yapılış tarihi geçen süre gibi veriler otomatik yapılacak şekilde ayarlamalar var. tekrarlayan arızalarda düşeyara formülü haricinde ne kullanılacak bilemedim. eğersay ile birleştirme düşündüm lakin formülleri değiştirmem gerekecekti. şimdiden emeği geçen herkese teşekkür ederim saygılar.

 

[numan şamil]

Merhaba arkadaşlar. excel dosyasında açıklamalar ekledim. basit bir arıza kayıt listesi oluşturacam 6 çeşit arıza kaydım var. bunların arıza kayıt tarihi yapılış tarihi geçen süre gibi veriler otomatik yapılacak şekilde ayarlamalar var. tekrarlayan arızalarda düşeyara formülü haricinde ne kullanılacak bilemedim. eğersay ile birleştirme düşündüm lakin formülleri değiştirmem gerekecekti. şimdiden emeği geçen herkese teşekkür ederim saygılar.

Merhaba
Kodları denermisiniz
Size fikir verebilir
Sub mükerrer()
Dim S1, S2 As Worksheet
Dim sat1 As Long, i As Long
Set S1 = Sheets("İŞLER")
Set S2 = Sheets("ARIZA GEÇMİŞİ")
S2.Range("B6:H" & Rows.Count).ClearContents
Application.ScreenUpdating = False
sat1 = S1.Cells(Rows.Count, "A").End(xlUp).Row
Satır = 6
For i = 2 To sat1
If WorksheetFunction.CountIf(S1.Range("A2:A" & i), S1.Cells(i, "A")) > 1 Then
S2.Range("B" & Satır).Value = S1.Range("B" & i).Value
S2.Range("C" & Satır).Value = S1.Range("E" & i).Value
S2.Range("D" & Satır).Value = S1.Range("F" & i).Value
S2.Range("E" & Satır).Value = S1.Range("G" & i).Value
S2.Range("F" & Satır).Value = S1.Range("H" & i).Value
S2.Range("G" & Satır).Value = CDate(S1.Range("H" & i)) - CDate(S1.Range("E" & i))
S2.Range("H" & Satır).Value = S1.Range("J" & i).Value
Satır = Satır + 1
End If
Next i
Application.ScreenUpdating = True
End Sub

 

[metince54]

Öncelikle elleriniz dert görmesin. kodu hangi sekmeye kod görüntüle diyeceğim. eskileri silecem mi? uygunsanız excel üzerine işlerseniz neler yapabilceğimi sölerseniz sevinirim. şimdiden teşekkür ederim ilginiz için.

Merhaba
Kodları denermisiniz
Size fikir verebilir
Sub mükerrer()
Dim S1, S2 As Worksheet
Dim sat1 As Long, i As Long
Set S1 = Sheets("İŞLER")
Set S2 = Sheets("ARIZA GEÇMİŞİ")
S2.Range("B6:H" & Rows.Count).ClearContents
Application.ScreenUpdating = False
sat1 = S1.Cells(Rows.Count, "A").End(xlUp).Row
Satır = 6
For i = 2 To sat1
If WorksheetFunction.CountIf(S1.Range("A2:A" & i), S1.Cells(i, "A")) > 1 Then
S2.Range("B" & Satır).Value = S1.Range("B" & i).Value
S2.Range("C" & Satır).Value = S1.Range("E" & i).Value
S2.Range("D" & Satır).Value = S1.Range("F" & i).Value
S2.Range("E" & Satır).Value = S1.Range("G" & i).Value
S2.Range("F" & Satır).Value = S1.Range("H" & i).Value
S2.Range("G" & Satır).Value = CDate(S1.Range("H" & i)) - CDate(S1.Range("E" & i))
S2.Range("H" & Satır).Value = S1.Range("J" & i).Value
Satır = Satır + 1
End If
Next i
Application.ScreenUpdating = True
End Sub