Diğer sürümlerde çalışan Kod Excel 2019 da çalışmıyor?

[muhsin066]

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Intersect(Target, [F2:R501]) Is Nothing Then Exit Sub
On Error GoTo son
Cells.Interior.ColorIndex = xlNone
Range(Cells(Target.Row, 6), Cells(Target.Row, 30)).Interior.ColorIndex = 8
son:

'SINAVGÖREVLERİ LİSTESİ
Cells(2, 2).Value = "Bakanlık Temsilcisi"
Cells(3, 2).Value = "Bina Görevlisi"
Cells(4, 2).Value = "Güvenlik Görevlisi"
Cells(5, 2).Value = "İl Sınav Sorumlusu"
Cells(6, 2).Value = "İl Sınav Sorumlusu Yardımcısı"
Cells(7, 2).Value = "Memur"
Cells(8, 2).Value = "Mutemet"
Cells(9, 2).Value = "Müdür Yardımcısı / İl / İlçe Şube Müdürü"
Cells(10, 2).Value = "Okul Bina Sorumlusu"
Cells(11, 2).Value = "Sınav Değerlendirme Komisyonu"
Cells(12, 2).Value = "Sınav Sürecini Kontrol ve Denetim"
Cells(13, 2).Value = "Sınav Yürütme Komisyonu Başkanı"
Cells(14, 2).Value = "Sınav Yürütme Komisyonu Üyesi"
Cells(15, 2).Value = "Şef"
Cells(16, 2).Value = "Şoför"
Cells(17, 2).Value = "Uygulama Sınavı Yürütme Komisyonu Başkanı"


'Cells(15, 3).Value = Application.Sum(Range("c2:c14")) 'TOPLAM görevli

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim sAdet As Integer

Cells(19, 3).Value = Application.Sum(Range("c2:c18")) 'TOPLAM görevli


sAdet = WorksheetFunction.CountA(Sheets("VERİLİS").Range("b2:b65000")) + 1
If Target.Column = 7 Then
For i = 1 To 6
On Error GoTo hata
If i = 3 Then
Target.Offset(0, i).Value = _
WorksheetFunction.VLookup(Target.Value, _
Sheets("VERİLİS").Range("b2:K" & sAdet), i + 1, 0) '* carp
Else
Target.Offset(0, i).Value = _
WorksheetFunction.VLookup(Target.Value, _
Sheets("VERİLİS").Range("b2:K" & sAdet), i + 1, 0)
End If
Next i
End If
Exit Sub
hata:
MsgBox ""
End Sub

 

[muhsin066]

Burda excel kapanıyor
Sub aktar_arşivekoçum()
Dim s1, s2 As Worksheet
Set s1 = Sheets("liste")
Set s2 = Sheets("arşiv")
Dim SonSat As Long

Sheets("arşiv").Select
'Range("a1:M201").ClearContents

'Cells(1, 1).Value = "S.NO"
Cells(2, 2).Value = "ADI VE SOYADI"
Cells(2, 3).Value = "T.C. KİMLİK NO"
'Cells(1, 4).Value = "ALACAKLI HESAP NO"
'Cells(1, 5).Value = "KADROSUNUN BULUNDUĞU YER"
'Cells(1, 6).Value = "KADRO UNVANI"
'Cells(1, 7).Value = "SINAV GÖREV TÜRÜ"
'Cells(1, 8).Value = "ŞUBE KODU"
'Cells(1, 9).Value = "PERSONEL STATÜSÜ"
'Cells(1, 10).Value = "CEP TEL NO"


'Range("a2:f101").Select


Sheets("liste").Select

SonSat = s1.Range("e65536").End(xlUp).Row
a = 2
For i = 1 To SonSat

' If s1.Cells(i, "e") > 0 Then
'If s1.Cells(i, "R") = "KP_RETURN" And s1.Cells(i, "K") > 0 Then
'If s1.Cells(i, "b") = Cells(1, 3).Value And s1.Cells(i, "g") = Cells(2, 3).Value Then
'If s1.Cells(i, "B") = "EVET" And s1.Cells(i, "I") = Sheets("toplis").Cells(5, 3).Value Then

a = a + 1

'arşiv SÜTUNLARI liste SÜTunları
s2.Cells(a, 2) = s1.Cells(i, "E") 'Adı soyadı verilis C Yİ arşiv 2. SÜTUNA AL
s2.Cells(a, 3) = s1.Cells(i, "D") 'tckn
's2.Cells(a, 4) = s1.Cells(i, "E") 'SINAVDAKİ GÖREVİ
's2.Cells(a, 5) = s1.Cells(i, "F") 'adısoyadı
's2.Cells(a, 6) = s1.Cells(i, "G")
's2.Cells(a, 7) = s1.Cells(i, "H")
's2.Cells(a, 8) = s1.Cells(i, "I")
's2.Cells(a, 9) = s1.Cells(i, "J")
' s2.Cells(a, 10) = s1.Cells(i, "K")

's2.Cells(a + 2, 4) = s1.Cells(i, "g") 'sınav görevi
's2.Cells(a, 5) = s1.Cells(i, "f") 'C SÜTUNU
' s2.Cells(a, 6) = s1.Cells(i, "g") 'C SÜTUNU
's2.Cells(a, 7) = s1.Cells(i, "h") 'C SÜTUNU

'End If
Next i

Sheets("arşiv").Select
Range("A1").Select
'verilis2
Sira_No_Ver2



End Sub
Sub Sira_No_Ver2()
Dim i As Long, No As Long
Sheets("arşiv").Select

For i = 2 To Range("b" & Rows.Count).End(xlUp).Row
If Cells(i, 2) <> Empty Then
No = No + 1
Cells(i, 1) = No
Else
Cells(i, 1) = Empty
End If
Next
End Sub
Sub verilis2()
'
' UstaListesi Makro
' Makro BEHCET tarafından 04.03.2011 tarihinde kaydedildi.
'
Sheets("VERİLİS").Select
'Range("A8:H38").Select
' Selection.ClearContents

'MsgBox "0'dan büyük " & WorksheetFunction.CountIf(Range("a2:a"), "<>0") & " kişilik liste var."
' Cells(1, 10).Value = WorksheetFunction.CountIf((Sheets("GOREVLİS").Range("A2:")), (">0"))
Cells(1, 50).Value = WorksheetFunction.CountA((Sheets("VERİLİS").Range("B2:B201")))
MsgBox "SINAV GÖREVİ OLANLAR AKTARILDI.", vbInformation, "BİLGİ:"
MsgBox "BU SINAVDA GÖREVLİ " & "( " & (Cells(1, 50).Value & " )" & " PERSONEL VAR."), , "DOĞRU MU?"

Range("A2:G101").Select
Selection.Sort Key1:=Range("A8"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

MesajAktar

Range("A2").Select
End Sub

Sub MesajAktar()
Dim baslik As String
Dim aciklama As String

Sheets("verilis").Select

baslik = "SAYFA UYARISI!"

aciklama = aciklama + "1:LÜTFEN LİSTEDEKİ GÖREVLİ PERSONELİN GÖREV TÜRÜ VE STATÜLERİNİ KONTROL EDİNİZ." + Chr(13)
aciklama = aciklama + "2:SINAVDA GÖREV ALANLARIN SAYISINI KONTROL EDİNİZ." + Chr(13)
aciklama = aciklama + "3:GEREKTİĞİNDE <ANALİSTE>SAYFASINA GEÇİP YENİDEN SEÇİNİZ.." + Chr(13)
aciklama = aciklama + "4:GÖREVLİ SAYISI TAMAM İSE <........> BUTONUNA TIKLAYIP SAYFAYA GEÇİNİZ.." + Chr(13)

MsgBox aciklama, , baslik

End Sub

 

[Zeki Gürsoy]

İki konuyu alışkanlık edinirseniz;
Programlama konusunda kendinize, başlığı okuma açısından bize iyiliğiniz olur.
- VB kodlarında değişken veya prosedur isimlerinde Türkçe harf kullanmayın
- Program kodlarını <CODE> tagları içine alın.

Burda excel kapanıyor

Sarı renk ile vurgulanmış satır Excel'in kapanmasına neden olmaz. Olsa olsa sayfa adını bulamaması durumunda çalışma zamanı hatası oluşur. Başka bir nedeni olmalı...

Türkçe harf düzeltmelerini yaparak tekrar deneyin...

.

 

[ÖmerFaruk]

Ben de sorunuza değil de kodlarınıza katkı olsun diye gördüğüm bir şeyi belirteyim.

Dim s1, s2 As Worksheet
Bu satırda değişkenleri böyle tanımlarsanız
s1 Variant olarak
s2 Worksheet olarak tanımlanır

Bunun yerine aşağıdaki gibi kullanmalısınız.
Dim s1 As Worksheet, s2 As Worksheet