Çözüldü VBA İle Boş Olan Hücrelere İlçe Verilerini Getir

[ErdalÖzdemir]

Merhaba arkadaşlar.

Aşağıdaki örnek tablodaki F. No başlığındaki boş hücrelere;
Eğer F. No boş ise, Mevki adları eşitse ve Kurum_Adı "İlçe Milli Eğitim" olanın F.No sunu getirmek istiyorum.

Üzerinde çok uğraştım fakat bir sonuca ulaşamadım.

Yardımlarınız için şimdiden teşekkür ederim.

Mevki_Adı	Yerleşim Yeri	Kurum_Adı	F. No
DANİŞMENT	İlçe	İlçe Sağlık	153125
DANİŞMENT	İlçe	İlçe Milli Eğitim	189123
SAYSALLI	İlçe	İlçe Sağlık	189128
NARLI	İlçe	İlçe Tarım	225121
DANİŞMENT	Belde	lçe Tarım
HASANCIK	İlçe	İlçe Sağlık	297117
HAYRİYE	İlçe	İlçe Milli Eğitim	333115
KAZICIK	İlçe	İlçe Sağlık	369113
HAYRİYE	İlçe	İlçe Milli Eğitim	405111
LALELİ	İlçe	İlçe Milli Eğitim	441109
HAYRİYE	Köy	İlçe Tarım
NURSAT	İlçe	İlçe Sağlık	513105
PİRELİ	İlçe	İlçe Milli Eğitim	549103
NURSAT	Belde	İlçe Sağlık
NARLI	İlçe	İlçe Tarım	621099

 

[Korhan Ayhan]

Verdiğiniz koşula göre NURSAT satırı boş kalacak. Doğrumudur?

 

[ErdalÖzdemir]

Evet Korhan Hocam

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Fill_Blank_Cells()
    Dim Rng As Range, Last_Row As Long, X_Row As Long

    Application.ScreenUpdating = False

    Last_Row = Cells(Rows.Count, 1).End(3).Row

    For Each Rng In Range("D2:D" & Rows.Count).SpecialCells(xlCellTypeBlanks).Cells
        On Error Resume Next
        X_Row = 0
        X_Row = Evaluate(Replace("=MATCH(""" & Rng.Offset(, -3) & """&""İlçe Milli Eğitim"",A1:A1048576&C1:C1048576,0)", 1048576, Last_Row))
        On Error GoTo 0
        If X_Row > 0 Then Rng = Cells(X_Row, "D")
    Next

    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[ErdalÖzdemir]

Korhan Hocam teşekkür ederim.

Orijinal tablomda binlerce satır var ve İlçe Milli Eğitim kısmı yüzlerce kez tekrar ediyor. Acaba bu kodu İf yapısını kullanarak yapabilir miyiz

if Cells (i, 4)="" And Cells (i, 3) Like "*İlçe*" And Cells (i, 1) =Cells (i, 1) ' İşte burada "Mevki_Adı alanını eşit ise gösterim kısmını yapamadım.

 

[Korhan Ayhan]

Önerdiğim kod if yapısına göre daha hızlı sonuç verecektir.

 

[ErdalÖzdemir]

Korhan Hocam, VBA'yı yeni yeni öğrenmeye çalışan biri olarak eğer mümkünse if yapısıyla olanı görmek isterim.

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Fill_Blank_Cells()
    Dim X As Long, Y As Long

    Application.ScreenUpdating = False

    For X = 2 To Cells(Rows.Count, 1).End(3).Row
        If Cells(X, "D") = "" Then
            For Y = 2 To Cells(Rows.Count, 1).End(3).Row
                If Cells(X, "A") = Cells(Y, "A") And Cells(Y, "C") = "İlçe Milli Eğitim" Then
                    Cells(X, "D") = Cells(Y, "D")
                    Exit For
                End If
            Next
        End If
    Next

    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[ErdalÖzdemir]

Korhan Hocam çok teşekkür ederim. Elinize emeğinize sağlık.

Hayırlı iftarlar.