Skip to main content

AccessTr.neT

Kayıt Ol

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

Ekders Uygulamasında Verileri Farklı Sayfadaki Tabloya Yerleştirmek

martineden-30
martineden-30
Excel Cevaplanmış Soruları
35
4558

Ekders Uygulamasında Verileri Farklı Sayfadaki Tabloya Yerleştirmek

#19
berduş
Berduş
berduş
Bul
Uzman
Adı Soyadı: ha....
Konum: -
Ofis Versiyonu: Ofis 2019 64 Bit
Son Oturumu: Dün,22:26
Yorumları: 8.402
Konuları: 94
Kayıt Tarihi: 30/07/2014
Teşekkür Puanı: 1.037
aşağıdaki kod ilk sayfadaki toplamlar sütunundan değerleri alıp puantaj2 sayfasına yapıştırıyor, işlem yükü azaldığı için daha hızlı.
Ama yeni öğretmenler eklenmesine rağmen toplam sütunundaki formül boş bırakılmışsa boş değer dönderir
Sub Puantaj2()

Dim xSatirNo, ASonSatir, FSonSatir, XAlanlar, xSiraNo, xSonSutun As Long

xSonSutun = Cells(3, Columns.Count).End(xlToLeft).Column ' - 1

SonHrf = Replace(Cells(1, xSonSutun).Address(0, 0), 1, "")

xSatirNo = 3

ASonSatir = Cells(Rows.Count, 1).End(xlUp).Row

FSonSatir = Cells(Rows.Count, 6).End(xlUp).Row



XAlanlar = 3

Do While 1 = 1



    xSatirNo = Range("A" & xSatirNo).End(xlDown).Row

    y = Range("a" & XAlanlar).Value

    x = XAlanlar

    Sheets("Puantaj2").Range("B" & 2 + y).Value = Range("D" & x).Value

    Sheets("Puantaj2").Range("C" & 2 + y).Value = Range("E" & x).Value

    If xSatirNo > ASonSatir Then Exit Do

    For x = XAlanlar To xSatirNo - 1

        y = Range("a" & XAlanlar).Value

      '  MsgBox ("R" & x & ":" & SonHrf & x)

        If Range("h" & x).Value = 101 Then Sheets("Puantaj2").Range("D" & 2 + y).Value = Range(SonHrf & x).Value

        If Range("h" & x).Value = 103 Then Sheets("Puantaj2").Range("f" & 2 + y).Value = Range(SonHrf & x).Value

        If Range("h" & x).Value = 106 Then Sheets("Puantaj2").Range("I" & 2 + y).Value = Range(SonHrf & x).Value

        If Range("h" & x).Value = 107 Then Sheets("Puantaj2").Range("K" & 2 + y).Value = Range(SonHrf & x).Value

        If Range("h" & x).Value = 108 Then Sheets("Puantaj2").Range("J" & 2 + y).Value = Range(SonHrf & x).Value

        If Range("h" & x).Value = 109 Then Sheets("Puantaj2").Range("L" & 2 + y).Value = Range(SonHrf & x).Value

        If Range("h" & x).Value = 116 Then Sheets("Puantaj2").Range("H" & 2 + y).Value = Range(SonHrf & x).Value

        If Range("h" & x).Value = 117 Then Sheets("Puantaj2").Range("G" & 2 + y).Value = Range(SonHrf & x).Value

        If Range("h" & x).Value = 119 Then Sheets("Puantaj2").Range("E" & 2 + y).Value = Range(SonHrf & x).Value





    Next

     XAlanlar = xSatirNo

Loop

    Sheets("Puantaj2").Range("B" & 2 + y).Value = Range("D" & x).Value

    Sheets("Puantaj2").Range("C" & 2 + y).Value = Range("E" & x).Value

    For x = XAlanlar To FSonSatir

        y = Range("a" & XAlanlar).Value

        If Range("h" & x).Value = 101 Then Sheets("Puantaj2").Range("D" & 2 + y).Value = Range(SonHrf & x).Value

        If Range("h" & x).Value = 103 Then Sheets("Puantaj2").Range("f" & 2 + y).Value = Range(SonHrf & x).Value

        If Range("h" & x).Value = 106 Then Sheets("Puantaj2").Range("I" & 2 + y).Value = Range(SonHrf & x).Value

        If Range("h" & x).Value = 107 Then Sheets("Puantaj2").Range("K" & 2 + y).Value = Range(SonHrf & x).Value

        If Range("h" & x).Value = 108 Then Sheets("Puantaj2").Range("J" & 2 + y).Value = Range(SonHrf & x).Value

        If Range("h" & x).Value = 109 Then Sheets("Puantaj2").Range("L" & 2 + y).Value = Range(SonHrf & x).Value

        If Range("h" & x).Value = 116 Then Sheets("Puantaj2").Range("H" & 2 + y).Value = Range(SonHrf & x).Value

        If Range("h" & x).Value = 117 Then Sheets("Puantaj2").Range("G" & 2 + y).Value = Range(SonHrf & x).Value

        If Range("h" & x).Value = 119 Then Sheets("Puantaj2").Range("E" & 2 + y).Value = Range(SonHrf & x).Value

    Next

MsgBox ("Son Sütun: " & SonHrf)

End Sub

2. yöntemde ise her toplama işlemini kendi yaptığı için daha ağır ama sonuç daha güvenilir
Sub Puantaj2()

Dim xSatirNo, ASonSatir, FSonSatir, XAlanlar, xSiraNo, xSonSutun As Long

xSonSutun = Cells(3, Columns.Count).End(xlToLeft).Column - 1

SonHrf = Replace(Cells(1, xSonSutun).Address(0, 0), 1, "")

xSatirNo = 3

ASonSatir = Cells(Rows.Count, 1).End(xlUp).Row

FSonSatir = Cells(Rows.Count, 6).End(xlUp).Row



XAlanlar = 3

Do While 1 = 1



    xSatirNo = Range("A" & xSatirNo).End(xlDown).Row

    y = Range("a" & XAlanlar).Value

    x = XAlanlar

    Sheets("Puantaj2").Range("B" & 2 + y).Value = Range("D" & x).Value

    Sheets("Puantaj2").Range("C" & 2 + y).Value = Range("E" & x).Value

    If xSatirNo > ASonSatir Then Exit Do

    For x = XAlanlar To xSatirNo - 1

        y = Range("a" & XAlanlar).Value

        If Range("h" & x).Value = 101 Then Sheets("Puantaj2").Range("D" & 2 + y).Value = Application.WorksheetFunction.Sum(Range("R" & x & ":" & SonHrf & x))  

        If Range("h" & x).Value = 103 Then Sheets("Puantaj2").Range("f" & 2 + y).Value = Application.WorksheetFunction.Sum(Range("R" & x & ":" & SonHrf & x))  

        If Range("h" & x).Value = 106 Then Sheets("Puantaj2").Range("I" & 2 + y).Value = Application.WorksheetFunction.Sum(Range("R" & x & ":" & SonHrf & x))   

        If Range("h" & x).Value = 107 Then Sheets("Puantaj2").Range("K" & 2 + y).Value = Application.WorksheetFunction.Sum(Range("R" & x & ":" & SonHrf & x))  

        If Range("h" & x).Value = 108 Then Sheets("Puantaj2").Range("J" & 2 + y).Value = Application.WorksheetFunction.Sum(Range("R" & x & ":" & SonHrf & x))   

        If Range("h" & x).Value = 109 Then Sheets("Puantaj2").Range("L" & 2 + y).Value = Application.WorksheetFunction.Sum(Range("R" & x & ":" & SonHrf & x))  

        If Range("h" & x).Value = 116 Then Sheets("Puantaj2").Range("H" & 2 + y).Value = Application.WorksheetFunction.Sum(Range("R" & x & ":" & SonHrf & x))   

        If Range("h" & x).Value = 117 Then Sheets("Puantaj2").Range("G" & 2 + y).Value = Application.WorksheetFunction.Sum(Range("R" & x & ":" & SonHrf & x))   

        If Range("h" & x).Value = 119 Then Sheets("Puantaj2").Range("E" & 2 + y).Value = Application.WorksheetFunction.Sum(Range("R" & x & ":" & SonHrf & x))  





    Next

     XAlanlar = xSatirNo

Loop

    Sheets("Puantaj2").Range("B" & 2 + y).Value = Range("D" & x).Value

    Sheets("Puantaj2").Range("C" & 2 + y).Value = Range("E" & x).Value

    For x = XAlanlar To FSonSatir

        y = Range("a" & XAlanlar).Value

        If Range("h" & x).Value = 101 Then Sheets("Puantaj2").Range("D" & 2 + y).Value = Application.WorksheetFunction.Sum(Range("R" & x & ":" & SonHrf & x))  

        If Range("h" & x).Value = 103 Then Sheets("Puantaj2").Range("f" & 2 + y).Value = Application.WorksheetFunction.Sum(Range("R" & x & ":" & SonHrf & x))   

        If Range("h" & x).Value = 106 Then Sheets("Puantaj2").Range("I" & 2 + y).Value = Application.WorksheetFunction.Sum(Range("R" & x & ":" & SonHrf & x))  

        If Range("h" & x).Value = 107 Then Sheets("Puantaj2").Range("K" & 2 + y).Value = Application.WorksheetFunction.Sum(Range("R" & x & ":" & SonHrf & x))  

        If Range("h" & x).Value = 108 Then Sheets("Puantaj2").Range("J" & 2 + y).Value = Application.WorksheetFunction.Sum(Range("R" & x & ":" & SonHrf & x))  

        If Range("h" & x).Value = 109 Then Sheets("Puantaj2").Range("L" & 2 + y).Value = Application.WorksheetFunction.Sum(Range("R" & x & ":" & SonHrf & x))  

        If Range("h" & x).Value = 116 Then Sheets("Puantaj2").Range("H" & 2 + y).Value = Application.WorksheetFunction.Sum(Range("R" & x & ":" & SonHrf & x))   

        If Range("h" & x).Value = 117 Then Sheets("Puantaj2").Range("G" & 2 + y).Value = Application.WorksheetFunction.Sum(Range("R" & x & ":" & SonHrf & x))   

        If Range("h" & x).Value = 119 Then Sheets("Puantaj2").Range("E" & 2 + y).Value = Application.WorksheetFunction.Sum(Range("R" & x & ":" & SonHrf & x))   

    Next

MsgBox ("Son Sütun: " & SonHrf)

End Sub
Cevapla

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

Yorum yapmak için üye olmanız gerekiyor

ya da

Bu Konudaki Yorumlar
Cvp: Ekders Uygulamasında Verileri Farklı Sayfadaki Tabloya Yerleştirmek - Yazar: berduş - 27/05/2019, 03:14
Task