• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Karışık atama bilgilerini belirli bir formatta düzenlemek

  • Konbuyu başlatan Konbuyu başlatan unur
  • Başlangıç tarihi Başlangıç tarihi

unur

Altın Üye
Katılım
8 Aralık 2005
Mesajlar
854
Excel Vers. ve Dili
İş:Excel 2000 Türkçe
Ev:Excel xp Türkçe
Arkadaşlar atamalarımız ekte gönderdiğim dosyadaki gibi geliyor bunu belirli bir formatta düzenlemek istiyorum yardımcı olursanız sevinirim.

Teşekkürler.
 

Ekli dosyalar

Kod:
Sub NN()
[e:f].Clear
For i = 2 To [a65536].End(3).Row
If Cells(i, 2) = "ESKİ GÖREV YERİ" Then

Cells(i - 1, "e") = Cells(i + 1, "c")
Cells(i - 1, "f") = Cells(i + 2, "c")
End If

Next
End Sub
 
Eline Sağlık Hamitcan çok Teşekkürler.
 
Hamitcan bey ilk iki kişiyi yapıyor ancak 3.Kişiyi yapmıyor kodlar ilk iki kişi içinmi düzenlendi acaba?

Birde zamanınız varsa kodların açıklamasını yazma şansınız varmı?Kendi dosyama uyarlarken lazım olacak.
Teşekkürler.
 
Kod:
For i = 2 To [a65536].End(3).Row
satırını aşağıdaki ile değiştirin.

Kod:
For i = 2 To [b65536].End(3).Row
 
Teşekkürler.
 
Kod:
Sub NN()
[e:f].Clear
For i = 2 To [a65536].End(3).Row
If Cells(i, 2) = "ESKİ GÖREV YERİ" Then

Cells(i - 1, "e") = Cells(i + 1, "c")
Cells(i - 1, "f") = Cells(i + 2, "c")
End If

Next
End Sub

Bu kodları açıklamasını yapacak bir arkadaşımız varmı acaba? birşeyleri yaparken öğrenmeye çalışıyım diye soruyorum.
Teşekkürler.
 
Kod:
Sub NN()
[e:f].Clear' E ve F sütunlarını sil.
For i = 2 To [a65536].End(3).Row 'B sütunundaki son hücreye kadar dön.
If Cells(i, 2) = "ESKİ GÖREV YERİ" Then ' Döngü çalışırken B sütununda "ESKİ GÖREV YERİ" kelimelerinin eşit olduğu hücre bulunduğunda 

Cells(i - 1, "e") = Cells(i + 1, "c")' Döngü satırına eşit ve E sütunu karşılığına, bir satır aşağı C sütunundaki değeri getir.
Cells(i - 1, "f") = Cells(i + 2, "c") ' Döngü satırına eşit ve F sütunu karşılığına, iki satır aşağı C sütunundaki değeri getir.
End If

Next
End Sub
 
Çok Teşekkürler Hamitcan Bey,
 
Arkadaşlar; Daha önce soruma sağolsunlar arkadaşlar yardımcı olmuştular.Şimdi bu bilgileri düzenlerken adı ve soyadını ve sicilinide ayırmak istiyorum dosya ektedir.Yardımcı olursanız sevinirim.
 

Ekli dosyalar

Örneğin; Sayfa2'de A2 hücresindeki isim "Mehmet Acı" olduğunu varsayın.
Kod:
=SOLDAN(DÜŞEYARA("*"&A2&"*";Sayfa1!B1:B20;1;YANLIŞ);MBUL(A2;DÜŞEYARA("*"&A2&"*";Sayfa1!B1:B20;1;YANLIŞ))-1)
 
Hamit hocam çok teşekkürler emeklerinize.
Daha önce konu ile ilgili gene sizin yazmış olduğunuz kodlarda revizyon yapabiliseniz çok memnun olurum. (Özür dilerim soruyu sorarken formulle cevap vereceğinizi düşünmeden sordum)
Sınıfı, Adı Soyadı, Sicili, Yeni görev yeri, ilçe/il şeklinde düzenleme yapmak istiyorum.

[e:f].Clear
For i = 2 To [b65536].End(3).Row
If Cells(i, 2) = "ESKİ GÖREV YERİ" Then

Cells(i - 1, "e") = Cells(i + 1, "c")
Cells(i - 1, "f") = Cells(i + 2, "c")
End If

Next
 
Dosya Ektedir.
 

Ekli dosyalar

Böyle deneyin.
Kod:
Private Sub CommandButton1_Click()
    [e:h].Clear
    For i = 2 To [b65536].End(3).Row
        If Cells(i, 2) = "ESKİ GÖREV YERİ" Then
            a = Split(Trim(" " & Cells(i - 1, 2)), " ")
            Cells(i - 1, "e") = a(0)
            Cells(i - 1, "f") = a(1) & " " & a(2)
            Cells(i - 1, "g") = a(3)
            Cells(i - 1, "h") = Cells(i + 1, "c")
            Cells(i - 1, "i") = Cells(i + 2, "c")
        End If
    Next
    MsgBox "Bitti"
End Sub
 
Teşekkürler Hamit hocam
run time error 13 diye bir hata veriyor ve
Cells(i - 1, "i") = Cells(i + 2, "c")
satırını sarı renge boyuyor.
Yardımcı olurmusunuz
 
Hocam Çok Teşekkürler.

Kodlarda denemeler yaptım son satırdaki komuttaki "i" yerine "ı" yazdığımda komut çalıştı.Teşekkürler.
 
Hamit Hocam Kodlar güzel çalışıyor ancak Mehmet Ali Birand gibi bir isimde sicil hanesine soyismi atıyor kodlarda nasıl bir revizyon yapılabilir acaba
Teşekkürler.
 
Kod:
Private Sub CommandButton1_Click()
    [e:h].Clear
    For i = 2 To [b65536].End(3).Row
        If Cells(i, 2) = "ESKİ GÖREV YERİ" Then
            x = WorksheetFunction.Search("[", Cells(i - 1, 2))
            a = Split(Trim(" " & Cells(i - 1, 2)), " ")
            Cells(i - 1, "e") = a(0)
            Cells(i - 1, "f") = Trim(Mid(Cells(i - 1, 2), Len(a(0)) + 2, x - Len(a(0)) - 2))
            Cells(i - 1, "g") = Mid(Cells(i - 1, 2), x, Len(Cells(i - 1, 2)))
            Cells(i - 1, "h") = Cells(i + 1, "c")
            Cells(i - 1, "i") = Cells(i + 2, "c")
        End If
    Next
    MsgBox "Bitti"
End Sub
 
Hamitcan hocam çok teşekkürler,Elinize sağlık.
 
Geri
Üst