Çözüldü Yanlış sınıf adını aratınca kodlar bir daha çalışmıyor.

Vurkan · 7 Ağu 2023

Arkadaşlar merhaba. Daha önce açmış olduğum dizi formüllerini koda çevirmek başlığındaki problemim Sayın Caylak üstadın yardımıyla çözüme kavuşmuştu. Ancak dosyayı kullanmaya başladığımda bir sorunla karşılaştım.
EZBER ve ÖDEV isimli sayfalarda B1 hücresine yazdığım sınıf adına göre listeleme yapıyor. Ama OKUL sayfasında olmayan bir sınıf girdim (5A diyelim) Tabii böyle bir sınıf olmadığından listeyi temizledi ve boş geldi. Ancak hemen ardından OKUL sayfasında olan sınıfları çağırdığımda da kod çalışmamaya başladı ve liste gelmedi. Bunun için yardımlarınızı bekliyorum. Saygılar.

Vurkan · 7 Ağu 2023

Arkadaşlar merhaba; sorun yaşadığım kod:

Sub Ezber_Liste(Sayfa As Worksheet)
Dim ss As Integer
ss = Sayfa.Range("C" & Rows.Count).End(xlUp).Row
Sayfa.Range("B3

" & ss) = ""
Set cn = CreateObject("Adodb.connection")
Set rs = CreateObject("Adodb.recordset")
cnstr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0 Xml;HDR=No"""
cn.Open (cnstr)
Sorgu = "select F3,F4 from [Excel 12.0 Xml;HDR=NO;Database=" & ThisWorkbook.FullName & "].[OKUL$] where F2 = '" & Sayfa.Range("B1").Text & "' order by F3"
Set rs = cn.Execute(Sorgu)
sat = 3
If Not rs.EOF Or Not rs.bof Then
rs.movefirst
Do While Not rs.EOF
Sayfa.Range("B" & sat) = sat - 2
Sayfa.Range("C" & sat) = rs(0)
Sayfa.Range("D" & sat) = rs(1)
sat = sat + 1
rs.movenext
Loop
End If
End Sub

Bu kod B1 hücresine olmayan sınıfı yazdığınızda veya B1 hücresindeyken (birşey yazmadan) enter yapınca çalışmayı durduruyor. Artık olan sınıfları da listelemiyor. Saygılar.

Vurkan · 7 Ağu 2023

Arkadaşlar tekrar merhaba;

Sub VeriEşleştirme()

Dim aktifSayfa As Worksheet
Dim okulSayfa As Worksheet
Dim arananVeri As String
Dim sonuçSatır As Long
Dim i As Long
Set aktifSayfa = ActiveSheet
Set okulSayfa = Sheets("OKUL") ' OKUL sayfasının adını buraya yazın
arananVeri = aktifSayfa.Range("B1").Value
sonuçSatır = 3 ' Sonuçların başlangıç satırını buraya yazın

' OKUL sayfasında B sütununda dolaşma
For i = 1 To okulSayfa.Cells(okulSayfa.Rows.Count, "B").End(xlUp).Row
' Eşleşen veri bulunduğunda sonuçları yazma
If okulSayfa.Range("B" & i).Value = arananVeri Then
aktifSayfa.Range("B" & sonuçSatır).Value = sonuçSatır - 2 ' B sütununa sonuç numarasını yazma
aktifSayfa.Range("C" & sonuçSatır).Value = okulSayfa.Range("C" & i).Value
aktifSayfa.Range("D" & sonuçSatır).Value = okulSayfa.Range("D" & i).Value
sonuçSatır = sonuçSatır + 1 ' sonuçSatırı 1 artırma
End If
Next i
End Sub

Bu kod ile sorunu çözdüm.
Bu koda ilaveten Sayfa koduna bu kod çalışmadan önce
Sheets("EZBER").Range("A2

50").Value = ""
ekledim. aksi halde geçmiş verileri silmiyordu. Saygılar.

murat_8181 · 7 Ağu 2023

Vurkan' Alıntı:
Arkadaşlar tekrar merhaba;

Sub VeriEşleştirme()

Dim aktifSayfa As Worksheet
Dim okulSayfa As Worksheet
Dim arananVeri As String
Dim sonuçSatır As Long
Dim i As Long
Set aktifSayfa = ActiveSheet
Set okulSayfa = Sheets("OKUL") ' OKUL sayfasının adını buraya yazın
arananVeri = aktifSayfa.Range("B1").Value
sonuçSatır = 3 ' Sonuçların başlangıç satırını buraya yazın

' OKUL sayfasında B sütununda dolaşma
For i = 1 To okulSayfa.Cells(okulSayfa.Rows.Count, "B").End(xlUp).Row
' Eşleşen veri bulunduğunda sonuçları yazma
If okulSayfa.Range("B" & i).Value = arananVeri Then
aktifSayfa.Range("B" & sonuçSatır).Value = sonuçSatır - 2 ' B sütununa sonuç numarasını yazma
aktifSayfa.Range("C" & sonuçSatır).Value = okulSayfa.Range("C" & i).Value
aktifSayfa.Range("D" & sonuçSatır).Value = okulSayfa.Range("D" & i).Value
sonuçSatır = sonuçSatır + 1 ' sonuçSatırı 1 artırma
End If
Next i
End Sub

Bu kod ile sorunu çözdüm.
Bu koda ilaveten Sayfa koduna bu kod çalışmadan önce
Sheets("EZBER").Range("A250").Value = ""
ekledim. aksi halde geçmiş verileri silmiyordu. Saygılar.

Sadece bu makroyu kullanarak denermisin "EZBER""sayfası için geçerli

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$1" Then
Dim srcWs As Worksheet
Dim destWs As Worksheet
Dim classValue As String
Dim lastRow As Long
Dim rowNum As Long

Set srcWs = ThisWorkbook.Sheets("OKUL")
Set destWs = ThisWorkbook.Sheets("EZBER")
classValue = Target.Value
lastRow = srcWs.Cells(srcWs.Rows.Count, "B").End(xlUp).Row

destWs.Range("B3:E100").ClearContents '

rowNum = 1

For i = 2 To lastRow
If srcWs.Cells(i, 2).Value = classValue Then
destWs.Cells(destWs.Rows.Count, "B").End(xlUp).Offset(1, 0).Value = rowNum
destWs.Cells(destWs.Rows.Count, "C").End(xlUp).Offset(1, 0).Value = srcWs.Cells(i, 3).Value
destWs.Cells(destWs.Rows.Count, "D").End(xlUp).Offset(1, 0).Value = srcWs.Cells(i, 4).Value
rowNum = rowNum + 1
End If
Next i
End If
End Sub

Refaz · 7 Ağu 2023

Vurkan' Alıntı:
ss = Sayfa.Range("C" & Rows.Count).End(xlUp).Row

Bunun altına alttaki kodu ekleyin sadece.

Kod:

Değerli Misafirimiz İçeriği Görebilmek İçin Üyemiz İseniz Giriş Yap'ın Ya da Üye Ol'un.

Vurkan · 7 Ağu 2023

Sayın murat_8181 verdiğiniz kodu sayfanın koduna ekledim. O da gayet güzel çalıştı. Teşekkür ederim.

Refaz · 7 Ağu 2023

Vurkan' Alıntı:
Sorgu = "select F3,F4 from [Excel 12.0 Xml;HDR=NO;Database=" & ThisWorkbook.FullName & "].[OKUL$] where F2 = '" & Sayfa.Range("B1").Text & "' order by F3"

Ayrıca yukardaki yerine alttaki gibi yazmak daha iyi olur.

C#:

Değerli Misafirimiz İçeriği Görebilmek İçin Üyemiz İseniz Giriş Yap'ın Ya da Üye Ol'un.

Vurkan · 7 Ağu 2023

Sayın Refaz izin öneriniz de sorunu çözmüştür. İkinci önerinizi de uyguladım.Teşekkürler.

Refaz · 7 Ağu 2023

Rica ederim,kolay gelsin.

Refaz · 8 Ağu 2023

Sonolarak şunuda yazayım kodunuzun hızlı çalışması için alttaki gibi deneyin.
Application.ScreenUpdating = False ve Application.ScreenUpdating = True bunuda ekledim.
Normalde döngüsüzde aktarılırdı ama yapan üstad öyle yapmış.

C#:

Değerli Misafirimiz İçeriği Görebilmek İçin Üyemiz İseniz Giriş Yap'ın Ya da Üye Ol'un.

Foruma hoş geldin 👋 Ziyaretçi

Çözüldü Yanlış sınıf adını aratınca kodlar bir daha çalışmıyor.

Vurkan

Ekli dosyalar

Refaz

Vurkan

Vurkan

murat_8181

Refaz

Vurkan

Refaz

Vurkan

Refaz

Refaz

Konuyu okuyanlar