- Katılım
- 25 Mayıs 2017
- Mesajlar
- 15
- Excel Vers. ve Dili
- 2013 Ingilizce
- Altın Üyelik Bitiş Tarihi
- 25.05.2022
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Merhaba,Merhaba,
1.Sheet2 de her personel tek bir satırda mı?
2. Aktarım yaptıktan sonra Sheet1 deki veriler silinecek mi?
3. Statuslerde sadece abnormal olanlar mı aktarılacak? çünkü onları renklendirmişsiniz.
Bu sorulara yanıt verin, yardımcı olacak arkadaşlar kesin olur.
Evet o sekilde bayagi bir ugrastirir bir de sheet1 de ayni kisiye ait birden fazla veri oldugu icin ilgili veriyi yerine uygun sekilde koyacak bir formul yazilmasi gerekli.bunun formülünü merak ediyorum ilk aklıma gelen = yapıp sayfa 1 deki ilgili satırı seçme şeklinde ama uğraştırır
Sub Aktar()
Dim S1 As Worksheet, _
S2 As Worksheet, _
c As Range, _
d As Range, _
i As Long, _
Tar As Date, _
Kol As Integer, _
Sat As Long, _
Sil As Boolean
Sil = False 'Aktarım yapıldıktan sonra Sheet1'deki
'verilerin Silinmesini İstiyorsanız Değeri TRUE Yapın
Set S1 = Sheets("Sheet1")
Set S2 = Sheets("Sheet2")
For i = 2 To S1.Cells(Rows.Count, "A").End(3).Row
If S1.Cells(i, "I") = "" Then
Tar = DateSerial(Left(S1.Cells(i, "C"), 4), Mid(S1.Cells(i, "C"), 6, 2), Right(S1.Cells(i, "C"), 2))
Kol = 0
Set c = S2.Range("1:1").Find(Tar, LookIn:=xlValues)
If Not c Is Nothing Then
Kol = c.Column
Else
MsgBox "Sheet2 de " & Tar & " Tarihi bulamadım"
End If
Set c = Nothing
If Not Kol = 0 Then
Set d = S2.Range("A:A").Find(S1.Cells(i, "A"), LookAt:=xlWhole)
If Not d Is Nothing Then
Sat = d.Row
Else
Sat = S2.Cells(Rows.Count, "A").End(3).Row + 1
S2.Cells(Sat, "A") = S1.Cells(i, "A")
S2.Cells(Sat, "B") = S1.Cells(i, "B")
End If
S2.Cells(Sat, Kol) = S1.Cells(i, "E")
S2.Cells(Sat, Kol + 1) = S1.Cells(i, "G")
S1.Cells(i, "I") = "X"
Set d = Nothing
Else
S1.Cells(i, "I") = "Tarih Hatası"
End If
End If
Next i
If Sil = True Then
Sat = S1.Cells(Rows.Count, "A").End(3).Row
If Sat < 2 Then Sat = 2
S1.Range("A2:I" & Sat).ClearContents
End If
MsgBox "Aktarım Tamamlanmıştır....", vbInformation, "www.excel.web.tr'den Necdet"
End Sub
Necdet Bey, dur biraz acele etme.... önümüz Bayram.Durum nedir? oldu muuu olmadı mı?
Peki Haluk bey, bekleyelim bakalım :biggrin:Necdet Bey, dur biraz acele etme.... önümüz Bayram.
Daha sonra inşallah ... :mrgreen:
.