Re: Rucü Davaları Yüklenici Ödemeleri - feraz - 18/11/2023
Aslında biraz daha kod kısalabilinir ama algoritmam iyi olmadığı için istediğimi yapamadım ama çalışıyor.
Yavaş çalışacakmı kendi dosyanızda deneyin bir.
PHP Kod:
Private Sub CommandButton1_Click() Dim i As Long, ii As Long, son As Long, say As Long Dim syf As Worksheet, aralik(), kac As Long, syfRucu As Worksheet Dim b2 As Long, f2 As Long, ilktrh As Long, sontrh As Long On Error Resume Next Set syf = ThisWorkbook.Worksheets(Range("I1").Value) On Error GoTo 0 Set syfRucu = ThisWorkbook.Worksheets("Rucü Yüklenici") say = 1 b2 = Cells(2, "B").Value2 f2 = syfRucu.Cells(2, "F").Value2 For i = syfRucu.Cells(2, "B").Value2 To (syfRucu.Cells(2, "F").Value2) ReDim Preserve aralik(1 To say) aralik(say) = i say = say + 1 Next say = 5 Union(syfRucu.Range("B5:C" & Rows.Count), syfRucu.Range("E5:E" & Rows.Count)).Value = "" If Not syf Is Nothing Then With syf For i = 2 To .Cells(Rows.Count, "A").End(3).Row + 1 ilktrh = .Cells(i, "B").Value2 sontrh = .Cells(i, "C").Value2 For ii = ilktrh To sontrh On Error Resume Next kac = 0 kac = WorksheetFunction.Match(ii, aralik, 0) On Error GoTo 0 If kac > 0 Then If b2 >= ilktrh Then syfRucu.Range("B" & say).Value = b2 Else syfRucu.Range("B" & say).Value = ilktrh End If syfRucu.Range("C" & say).Value = .Cells(i, "C").Value say = say + 1 Exit For End If Next Next End With End If Set syf = Nothing: Set syfRucu = Nothing End Sub
RE: Rucü Davaları Yüklenici Ödemeleri - cdenktas - 20/11/2023
(18/11/2023, 00:04)feraz yazdı: Aslında biraz daha kod kısalabilinir ama algoritmam iyi olmadığı için istediğimi yapamadım ama çalışıyor.
Yavaş çalışacakmı kendi dosyanızda deneyin bir.
PHP Kod:
Private Sub CommandButton1_Click() Dim i As Long, ii As Long, son As Long, say As Long Dim syf As Worksheet, aralik(), kac As Long, syfRucu As Worksheet Dim b2 As Long, f2 As Long, ilktrh As Long, sontrh As Long On Error Resume Next Set syf = ThisWorkbook.Worksheets(Range("I1").Value) On Error GoTo 0 Set syfRucu = ThisWorkbook.Worksheets("Rucü Yüklenici") say = 1 b2 = Cells(2, "B").Value2 f2 = syfRucu.Cells(2, "F").Value2 For i = syfRucu.Cells(2, "B").Value2 To (syfRucu.Cells(2, "F").Value2) ReDim Preserve aralik(1 To say) aralik(say) = i say = say + 1 Next say = 5 Union(syfRucu.Range("B5:C" & Rows.Count), syfRucu.Range("E5:E" & Rows.Count)).Value = "" If Not syf Is Nothing Then With syf For i = 2 To .Cells(Rows.Count, "A").End(3).Row + 1 ilktrh = .Cells(i, "B").Value2 sontrh = .Cells(i, "C").Value2 For ii = ilktrh To sontrh On Error Resume Next kac = 0 kac = WorksheetFunction.Match(ii, aralik, 0) On Error GoTo 0 If kac > 0 Then If b2 >= ilktrh Then syfRucu.Range("B" & say).Value = b2 Else syfRucu.Range("B" & say).Value = ilktrh End If syfRucu.Range("C" & say).Value = .Cells(i, "C").Value say = say + 1 Exit For End If Next Next End With End If Set syf = Nothing: Set syfRucu = Nothing End Sub
iyi günler;
iyi haftalar, yazmış olduğunuz kodu aldığımda program kod kısmına gidip run yaptığımda çalışıyor. Birde firma isimleri gelmiyor. Aynı zamanda kişi 30.07.2007 ayrıldığını düşünürsek, sistem 30.07.2007 yerine 31.07.2007 atıyor.
RE: Rucü Davaları Yüklenici Ödemeleri - feraz - 20/11/2023
Firma adlarını ekledim.
Tarih için sayfada anlatın.
RE: Rucü Davaları Yüklenici Ödemeleri - cdenktas - 21/11/2023
(20/11/2023, 17:37)feraz yazdı: Firma adlarını ekledim.
Tarih için sayfada anlatın.
Merhabalar;
Personel işe giriş tarihi bizim veri, ambulans, temizlik vs. sayfalarda belirtmiş olduğumuz tarih aralıkların arasında işe girmiş veya çıkmış olabilir.
Örneğin Veri Giriş Sayfasına baktığımızda;
16.05.2005 31.05.2005 Yüklenici a
1.06.2005 30.06.2005 YÜklenici b
Kişi işe giriş tarihi : 21.05.2005
Çıkış Tarihi : 28.06.2005 olduğu varsayalım;
Bu kişi Veri Giriş Sayfasındaki baktığımızda;
21.05.2005 tarihi 20.05.2005-31.05.2005 arasında olup işe başlama tarihi Rucü sayfasında;
ilk satır 21.05.2005 ile 31.05.2005 olması
Çıkış tarihi 28.06.2005 olduğundan 01.06.2005-30.06.2005 arasında olduğundan
İkinic satır (E6) 28.06.2005 olması gerekir.
Ellerinize sağlık...
RE: Rucü Davaları Yüklenici Ödemeleri - feraz - 21/11/2023
Abey ben anlamıyorım fazla,inşaAllah yardımcı olan çıkacaktır.
Kolay gelsin.
Re: Rucü Davaları Yüklenici Ödemeleri - feraz - 21/11/2023
Son olarak birde bu kodu deneyin.
If say > 5 Then syfRucu.Range("C" & say - 1).Value = syfRucu.Cells(2, "F").Value bu kodu ekledim sadece.
Kod:
Private Sub CommandButton1_Click()
Dim i As Long, ii As Long, son As Long, say As Long
Dim syf As Worksheet, aralik(), kac As Long, syfRucu As Worksheet
Dim b2 As Long, ilktrh As Long, sontrh As Long
On Error Resume Next
Set syf = ThisWorkbook.Worksheets(Range("I1").Value)
On Error GoTo 0
Set syfRucu = ThisWorkbook.Worksheets("Rucü Yüklenici")
say = 1
b2 = Cells(2, "B").Value2
For i = syfRucu.Cells(2, "B").Value2 To (syfRucu.Cells(2, "F").Value2)
ReDim Preserve aralik(1 To say)
aralik(say) = i: say = say + 1
Next
say = 5
Union(syfRucu.Range("B5:C" & Rows.Count), syfRucu.Range("E5:E" & Rows.Count)).Value = ""
If Not syf Is Nothing Then
With syf
For i = 2 To .Cells(Rows.Count, "A").End(3).Row + 1
ilktrh = .Cells(i, "B").Value2
sontrh = .Cells(i, "C").Value2
For ii = ilktrh To sontrh
On Error Resume Next
kac = 0
kac = WorksheetFunction.Match(ii, aralik, 0)
On Error GoTo 0
If kac > 0 Then
If b2 >= ilktrh Then
syfRucu.Range("B" & say).Value = b2
Else
syfRucu.Range("B" & say).Value = ilktrh
End If
syfRucu.Range("C" & say).Value = .Cells(i, "C").Value
syfRucu.Range("E" & say).Value = .Cells(i, "A").Value
say = say + 1
Exit For
End If
Next
Next
End With
If say > 5 Then syfRucu.Range("C" & say - 1).Value = syfRucu.Cells(2, "F").Value
End If
Set syf = Nothing: Set syfRucu = Nothing
End Sub
|