Skip to main content

AccessTr.neT


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

martineden-30
martineden-30
35
4508

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

#31
kod satırlarını kontrol ettim aynısı. zaten dediğim gibi sizin gönderdiğiniz dosya üzerinde bir oynama yapmadan ekran görüntüsü aldım
martineden-30, 11-04-2010 tarihinden beri AccessTr.neT Üyesidir.
Cevapla
#32
"Puantaj2Hesap" fonksiyonuna 1 satır eklenip hemen altındaki 10 öğretmen kontrol döngüsü değiştirildi
aşağıdaki 2 satır değiştirilen satırlar.
dilerim düzelmiştir

satirKont = WorksheetFunction.CountA(Sheets("Puantaj2").Range("A" & yPntj & ":c" & yPntj))  '<== Eklenen Satır
       If yPntj > 12 And satirKont = 1 Then  '<== Düzenlenen Satır  "And satirKont = 1" eklendi
aşağıdaki kod da fonksiyonun tamamı
Sub Puantaj2Hesap()
Dim EkASon, EkFSon, EkSonStn, X0, X1, yPntj, zSon As Long
Dim satirKont As Integer
On Error Resume Next
Tbas = Now
EkASon = Cells(Rows.Count, 1).End(xlUp).Row '
EkFSon = Cells(Rows.Count, 6).End(xlUp).Row
EkSonStn = Cells(3, Columns.Count).End(xlToLeft).Column


X0 = 3
X1 = 3
yPntj = 3
   Do While X1 <= EkFSon
satirKont = WorksheetFunction.CountA(Sheets("Puantaj2").Range("A" & yPntj & ":c" & yPntj))  '<== Eklenen Satır
       If yPntj > 12 And satirKont = 1 Then  '<== Düzenlenen Satır  "And satirKont = 1" eklendi
       Sheets("Puantaj2").Rows(yPntj).Insert Shift:=xlShiftDown, CopyOrigin:=0
       End If

       Sheets("Puantaj2").Range("A" & yPntj) = Range("A" & X0)
       Sheets("Puantaj2").Range("B" & yPntj) = Range("D" & X0)
       Sheets("Puantaj2").Range("C" & yPntj) = Range("E" & X0)
       X1 = Range("A" & X0).End(xlDown).Row
       If X1 > EkFSon Then X1 = EkFSon + 1
       For x = X0 To X1 - 1
           stn = vCevir2(Range("h" & x).Value)
           Sheets("Puantaj2").Range(stn & yPntj).Value = Cells(x, EkSonStn).Value
       Next
   yPntj = yPntj + 1
   X0 = X1

   Loop
'Formul___________________
zSon = Sheets("Puantaj2").Cells(Rows.Count, 13).End(xlUp).Row '13 ==> M sütunu
Sheets("Puantaj2").Range("M3") = "=sum(D3:L3)"
Sheets("Puantaj2").Range("M3:M" & zSon).FillDown
Sheets("Puantaj2").Range("D" & zSon) = "=sum(D3Lol" & zSon - 1 & ")"
Sheets("Puantaj2").Range("D" & zSon & ":L" & zSon).FillRight
'___________________bitti
'Çerçeve__________________________
Range("A12:L" & zSon - 1).Borders.LineStyle = xlContinuous
'___________________Bitti

Tbit = Now
Sure = DateDiff("s", Tbas, Tbit) 'Tbit - Tbas
tSny = Sure Mod 60
tDk = Sure \ 60
MsgBox ("İşlem " & tDk & " dakika :" & tSny & " saniyede bitti") ' Tbit & " - " & Tbas)
End Sub
Cevapla
#33
Sayın Haliliyas 
Gayet iyi oldu. çok düzgün çalışıyor. Çok teşekkür ediyorum. 
Emeğinize sağlık
martineden-30, 11-04-2010 tarihinden beri AccessTr.neT Üyesidir.
Cevapla
#34
şu an sorunsuz çalışıyor mu?
Cevapla
#35
Evet O sayfa sorunsuz çalışıyor çok teşekkür ediyorum
martineden-30, 11-04-2010 tarihinden beri AccessTr.neT Üyesidir.
Cevapla
#36
ÖD
iyi çalışmalar
Cevapla

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

Yorum yapmak için üye olmanız gerekiyor

ya da
Task