Konu Araçları | Konu Seçenekleri | Gösterim Stili
Tarih
26/05/2019 20:28
Konu Sahibi
martineden-30
Yorumlar
35
Okunma
683
Konuyu Oyla:
  • Derecelendirme: 0/5 - 0 oy
  • 1
  • 2
  • 3
  • 4
  • 5
martineden-30

martineden-30

Aktif Üye*
18114
 38
 12
 58
 11/04/2010
0
 Ağrı
 
 -
 13/06/2019,23:41
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.

halily

halily

Uzman
65596
ha....
 26
 1.269
 30/07/2014
215
 -
 
 Ofis 2019 64 Bit
"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



...........
martineden-30

martineden-30

Aktif Üye*
18114
 38
 12
 58
 11/04/2010
0
 Ağrı
 
 -
 13/06/2019,23:41
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.

halily

halily

Uzman
65596
ha....
 26
 1.269
 30/07/2014
215
 -
 
 Ofis 2019 64 Bit
şu an sorunsuz çalışıyor mu?




...........
martineden-30

martineden-30

Aktif Üye*
18114
 38
 12
 58
 11/04/2010
0
 Ağrı
 
 -
 13/06/2019,23:41
Evet O sayfa sorunsuz çalışıyor çok teşekkür ediyorum


martineden-30, 11-04-2010 tarihinden beri AccessTr.neT Üyesidir.

halily

halily

Uzman
65596
ha....
 26
 1.269
 30/07/2014
215
 -
 
 Ofis 2019 64 Bit
ÖD
iyi çalışmalar



...........

Konuyu Okuyanlar: 1 Ziyaretçi

Konu ile Alakalı Benzer Konular
Konular Yazar Yorumlar Okunma Son Yorum
Çözüldü Ekders Uygulamasında Sayfa 1'de Silinen Verilerin Sayfa 3'te Silinmemesi martineden-30 2 195 04/06/2019, 16:11
Son Yorum: martineden-30
Çözüldü Önce Bul Sonra Kaydet Veya Farklı Kaydet comp_wolf 38 1.131 30/04/2019, 09:10
Son Yorum: comp_wolf
Çözüldü Verileri Sayfalara Ayırma amelie 3 319 26/03/2019, 17:15
Son Yorum: halily
Çözüldü Php Mysqli Aynı Anda İki Farklı Tablo Güncelleme serkandiker 4 461 25/06/2018, 11:25
Son Yorum: ozguryasin
Çözüldü Dosyayı Farklı Kaydet - kaydet - kopya oluştur husem 2 630 18/03/2017, 00:34
Son Yorum: husem

Türkçe Çeviri: MCTR, Yazılım: MyBB, © 2002-2019 MyBB Group.