RE: Rucü Davaları Yüklenici Ödemeleri - cdenktas - 22/11/2023
(21/11/2023, 18:31)feraz yazdı: 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
Ellerinize sağlık bence oldu; ancak kodları otomatik çalışmıyor, Kod kısmında "run" bastığımda çalışıyor.
RE: Rucü Davaları Yüklenici Ödemeleri - feraz - 22/11/2023
Neyi seçince otomatik olmasını istiyor sunuz?
RE: Rucü Davaları Yüklenici Ödemeleri - feraz - 22/11/2023
Kodu Rücu sayfanın kod bölümüne ekleyin.
Tarihler ve Gürevi(I1) değişince kodçalışır.
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
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, I1 As String, ilktrh As Long, sontrh As Long
If Not Intersect(Target, Range("B2,F2,I1")) Is Nothing Then
Set syfRucu = ThisWorkbook.Worksheets("Rucü Yüklenici")
b2 = Cells(2, "B").Value2: f2 = syfRucu.Cells(2, "F").Value2: I1 = syfRucu.Cells(1, "I").Value2
Union(syfRucu.Range("B5:C" & Rows.Count), syfRucu.Range("E5:E" & Rows.Count)).Value = ""
If Len(Trim(b2)) > 1 And Trim(b2) > 0 And Trim(f2) > 0 And Len(Trim(f2)) > 1 And Len(Trim(I1)) > 0 Then
On Error Resume Next
Set syf = ThisWorkbook.Worksheets(Range("I1").Value)
On Error GoTo 0
say = 1
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
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
End If
End If
Set syf = Nothing: Set syfRucu = Nothing
End Sub
RE: Rucü Davaları Yüklenici Ödemeleri - cdenktas - 23/11/2023
(22/11/2023, 18:38)feraz yazdı: Kodu Rücu sayfanın kod bölümüne ekleyin.
Tarihler ve Gürevi(I1) değişince kodçalışır.
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
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, I1 As String, ilktrh As Long, sontrh As Long
If Not Intersect(Target, Range("B2,F2,I1")) Is Nothing Then
Set syfRucu = ThisWorkbook.Worksheets("Rucü Yüklenici")
b2 = Cells(2, "B").Value2: f2 = syfRucu.Cells(2, "F").Value2: I1 = syfRucu.Cells(1, "I").Value2
Union(syfRucu.Range("B5:C" & Rows.Count), syfRucu.Range("E5:E" & Rows.Count)).Value = ""
If Len(Trim(b2)) > 1 And Trim(b2) > 0 And Trim(f2) > 0 And Len(Trim(f2)) > 1 And Len(Trim(I1)) > 0 Then
On Error Resume Next
Set syf = ThisWorkbook.Worksheets(Range("I1").Value)
On Error GoTo 0
say = 1
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
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
End If
End If
Set syf = Nothing: Set syfRucu = Nothing
End Sub
Süper, emeğinize ve sabırlınıza için çok teşekkür ederim.
Süre kısımını yaparken C5-b5+1 yapıyorum, d5 aşağıya sürüklediğimde 1 geliyor,
Şunu denedim =eğer(b5=""; c5-b5+1";" ") yaptığımda #DEĞER çıkıyor, nerede hata yapıyorum bilmiyorum. Kurmuş olduğum fikir b5 boş ise d hücresi boş olsun...
(23/11/2023, 09:05)cdenktas yazdı: (22/11/2023, 18:38)feraz yazdı: Kodu Rücu sayfanın kod bölümüne ekleyin.
Tarihler ve Gürevi(I1) değişince kodçalışır.
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
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, I1 As String, ilktrh As Long, sontrh As Long
If Not Intersect(Target, Range("B2,F2,I1")) Is Nothing Then
Set syfRucu = ThisWorkbook.Worksheets("Rucü Yüklenici")
b2 = Cells(2, "B").Value2: f2 = syfRucu.Cells(2, "F").Value2: I1 = syfRucu.Cells(1, "I").Value2
Union(syfRucu.Range("B5:C" & Rows.Count), syfRucu.Range("E5:E" & Rows.Count)).Value = ""
If Len(Trim(b2)) > 1 And Trim(b2) > 0 And Trim(f2) > 0 And Len(Trim(f2)) > 1 And Len(Trim(I1)) > 0 Then
On Error Resume Next
Set syf = ThisWorkbook.Worksheets(Range("I1").Value)
On Error GoTo 0
say = 1
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
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
End If
End If
Set syf = Nothing: Set syfRucu = Nothing
End Sub
Süper, emeğinize ve sabırlınıza için çok teşekkür ederim.
Süre kısımını yaparken C5-b5+1 yapıyorum, d5 aşağıya sürüklediğimde 1 geliyor,
Şunu denedim =eğer(b5=""; c5-b5+1";" ") yaptığımda #DEĞER çıkıyor, nerede hata yapıyorum bilmiyorum. Kurmuş olduğum fikir b5 boş ise d hücresi boş olsun...
(23/11/2023, 09:05)cdenktas yazdı: (22/11/2023, 18:38)feraz yazdı: Kodu Rücu sayfanın kod bölümüne ekleyin.
Tarihler ve Gürevi(I1) değişince kodçalışır.
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
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, I1 As String, ilktrh As Long, sontrh As Long
If Not Intersect(Target, Range("B2,F2,I1")) Is Nothing Then
Set syfRucu = ThisWorkbook.Worksheets("Rucü Yüklenici")
b2 = Cells(2, "B").Value2: f2 = syfRucu.Cells(2, "F").Value2: I1 = syfRucu.Cells(1, "I").Value2
Union(syfRucu.Range("B5:C" & Rows.Count), syfRucu.Range("E5:E" & Rows.Count)).Value = ""
If Len(Trim(b2)) > 1 And Trim(b2) > 0 And Trim(f2) > 0 And Len(Trim(f2)) > 1 And Len(Trim(I1)) > 0 Then
On Error Resume Next
Set syf = ThisWorkbook.Worksheets(Range("I1").Value)
On Error GoTo 0
say = 1
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
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
End If
End If
Set syf = Nothing: Set syfRucu = Nothing
End Sub
Süper, emeğinize ve sabırlınıza için çok teşekkür ederim.
Süre kısımını yaparken C5-b5+1 yapıyorum, d5 aşağıya sürüklediğimde 1 geliyor,
Şunu denedim =eğer(b5=""; c5-b5+1";" ") yaptığımda #DEĞER çıkıyor, nerede hata yapıyorum bilmiyorum. Kurmuş olduğum fikir b5 boş ise d hücresi boş olsun...
(23/11/2023, 09:05)cdenktas yazdı: (22/11/2023, 18:38)feraz yazdı: Kodu Rücu sayfanın kod bölümüne ekleyin.
Tarihler ve Gürevi(I1) değişince kodçalışır.
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
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, I1 As String, ilktrh As Long, sontrh As Long
If Not Intersect(Target, Range("B2,F2,I1")) Is Nothing Then
Set syfRucu = ThisWorkbook.Worksheets("Rucü Yüklenici")
b2 = Cells(2, "B").Value2: f2 = syfRucu.Cells(2, "F").Value2: I1 = syfRucu.Cells(1, "I").Value2
Union(syfRucu.Range("B5:C" & Rows.Count), syfRucu.Range("E5:E" & Rows.Count)).Value = ""
If Len(Trim(b2)) > 1 And Trim(b2) > 0 And Trim(f2) > 0 And Len(Trim(f2)) > 1 And Len(Trim(I1)) > 0 Then
On Error Resume Next
Set syf = ThisWorkbook.Worksheets(Range("I1").Value)
On Error GoTo 0
say = 1
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
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
End If
End If
Set syf = Nothing: Set syfRucu = Nothing
End Sub
Süper, emeğinize ve sabırlınıza için çok teşekkür ederim.
Süre kısımını yaparken C5-b5+1 yapıyorum, d5 aşağıya sürüklediğimde 1 geliyor,
Şunu denedim =eğer(b5=""; c5-b5+1";" ") yaptığımda #DEĞER çıkıyor, nerede hata yapıyorum bilmiyorum. Kurmuş olduğum fikir b5 boş ise d hücresi boş olsun...
[img][/img]
RE: Rucü Davaları Yüklenici Ödemeleri - feraz - 23/11/2023
Rica ederim,alttaki gibi şart ekleyin ve diğerlerinede aynısını uygulayın.Çift tırnak içinde boşluk olmayacak.
Kod:
=EĞER(B5="";"";C5-B5+1)
Yada B ve C sütunlarındaki tarihten herhangi biri boşsa alttaki kod daha iyi.
Kod:
=EĞER(YADA(B5="";C5="");"";C5-B5+1)
|