Skip to main content

AccessTr.neT

Kayıt Ol

 | Facebook ile Bağlan  | Twitter İle Bağlan | Google+ İle Bağlan

Rucü Davaları Yüklenici Ödemeleri

cdenktas
cdenktas
Excel Cevaplanmış Soruları
22
662

Rucü Davaları Yüklenici Ödemeleri

#19
cdenktas
Aktif Üye
cdenktas
Bul
Aktif Üye
Adı Soyadı:
Yaşı: 45
Konum: -
Ofis Versiyonu: -
Son Oturumu: 22/04/2024,15:26
Yorumları: 161
Konuları: 37
Kayıt Tarihi: 19/09/2019
Teşekkür Puanı: 0
(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.
Cevapla
#20
feraz
Uzman
feraz
Bul
Uzman
Adı Soyadı: Za....
Yaşı: 47
Konum: -
Ofis Versiyonu: Diğer
Son Oturumu: 20/04/2024,03:16
Yorumları: 3.637
Konuları: 95
Kayıt Tarihi: 30/03/2013
Teşekkür Puanı: 316
Neyi seçince otomatik olmasını istiyor sunuz?
Cevapla
#21
feraz
Uzman
feraz
Bul
Uzman
Adı Soyadı: Za....
Yaşı: 47
Konum: -
Ofis Versiyonu: Diğer
Son Oturumu: 20/04/2024,03:16
Yorumları: 3.637
Konuları: 95
Kayıt Tarihi: 30/03/2013
Teşekkür Puanı: 316
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
Cevapla
#22
cdenktas
Aktif Üye
cdenktas
Bul
Aktif Üye
Adı Soyadı:
Yaşı: 45
Konum: -
Ofis Versiyonu: -
Son Oturumu: 22/04/2024,15:26
Yorumları: 161
Konuları: 37
Kayıt Tarihi: 19/09/2019
Teşekkür Puanı: 0
(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.

[Resim: C:\fakepath\Resim_3.jpg]

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.

[Resim: C:\fakepath\Resim_3.jpg]

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.

[Resim: C:\fakepath\Resim_3.jpg]

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.

[Resim: C:\fakepath\Resim_3.jpg]

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][Resim: do.php?img=15476][/img]
Son Düzenleme: 23/11/2023, 09:09, Düzenleyen: cdenktas.
Cevapla
#23
feraz
Uzman
feraz
Bul
Uzman
Adı Soyadı: Za....
Yaşı: 47
Konum: -
Ofis Versiyonu: Diğer
Son Oturumu: 20/04/2024,03:16
Yorumları: 3.637
Konuları: 95
Kayıt Tarihi: 30/03/2013
Teşekkür Puanı: 316
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)
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da
Task