Şartlı veri çağırma

[mtozer]

sa1 de bulunan G:N sütüunları arasındaki verileri fis sayfasında c sütununa aktarmak istiyorum hocam.

http://s3.dosya.tc/server11/qd6dlo/fis_.rar.html

 

[mtozer]

sa1 deki G:N sütunu arasındaki verileri fis sayfasındaki c sütununa atmak istiyorum.


http://s3.dosya.tc/server11/qd6dlo/fis_.rar.html

 

[Ömer]

birde bir sorun daha var hocam. hücre çizgilerini yaptıgımda veri çağırınca çizgileri bozuyor. incelermisiniz.

Bunun için combobox daki kodlarda;

S1.Cells(c.Row + 1, "A").Resize(a, 6).Copy Range("A5")

yukarıdaki yazdığım satırı bulup silin ve aşağıdaki satırları aynı bölgeye ekleyin.

S1.Cells(c.Row + 1, "A").Resize(a, 6).Copy
Range("A5").PasteSpecial xlPasteValues, xlNone
Application.CutCopyMode = False

Ve kırmızı ilaveyi yapın.

Range("A5:F" & Rows.Count).Clear[COLOR="Red"]Contents[/COLOR]

.

 

[mtozer]

olmadı hocam. hiçbirşey getirmedi.

 

[Ömer]

Combobox1 kodlarını aşağıdaki kodlarla değiştirerek deneyiniz.

Private Sub ComboBox1_Change()

    Dim S1 As Worksheet, c As Range, a As Long
    
    Set S1 = Sheets("sa1")
    
    Application.ScreenUpdating = False
    Range("A5:F" & Rows.Count).ClearContents
    Range("B2") = ComboBox1.Value

    Set c = S1.[B:B].Find(Range("B2"), , xlValues, xlWhole)
    If Not c Is Nothing Then
        If WorksheetFunction.CountIf(S1.Range("A" & c.Row + 1 & ":A" & Rows.Count), _
            S1.Range("A2")) = 0 Then
            a = S1.Cells(Rows.Count, "A").End(xlUp).Row - c.Row
        Else
            a = WorksheetFunction.Match(S1.Range("A2"), _
                S1.Range("A" & c.Row + 1 & ":A" & Rows.Count), 0) - 1
        End If
        S1.Cells(c.Row + 1, "A").Resize(a, 6).Copy
        Range("A5").PasteSpecial xlPasteValues, xlNone
        Application.CutCopyMode = False
        
        Cells(a + 10, "C") = "Toplam"
        Cells(a + 11, "C") = "İşçilik KDV Dahil Tutarı"
        Cells(a + 12, "C") = "Mlz. KDV Dahil Tutarı"
        Cells(a + 13, "C") = "KDV Dahil Tutar"
        
        Cells(a + 10, "D") = S1.Cells(c.Row, "H")
        Cells(a + 11, "D") = S1.Cells(c.Row, "L")
        Cells(a + 12, "D") = S1.Cells(c.Row, "J")
        Cells(a + 13, "D") = S1.Cells(c.Row, "N")
        Columns("C:C").EntireColumn.AutoFit
        Range("B2").Select
    End If
    
    Unload Me
    Application.ScreenUpdating = True

End Sub

.

 

[mtozer]

elinize sağlık. Çok teşekkür ederim hocam. hücre biçimide düzelmiş.

 

[Ömer]

Rica ederim, iyi çalışmalar.

 

[mtozer]

Bu açıklamayı şunun için yapıyorum. Bazen cevaplarda sezlenişler hissediyorum. Bizim gibi vba konusunda yetersiz olan insanlar için formların ve sizin gibi ilgili insanların olması çok faydalı. Ben 2-3 yilda bir arkadaslarımın işini kolaylaştırmak amacı ile birşeyler yapmaya çalıyorum. Asıl siz yapıyorsunuz bunuda kendilerine iletiyorum zaten. Bu yuzden tekrar tekrar bütün formdaki arkadaslara tesekkur ederim.
Herkese iyi çalışmalar dilerim.