Skip to main content

AccessTr.neT M.


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

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

Visual Basic Code
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ı

Visual Basic Code
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
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(D3:D" & 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