• DİKKAT

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

ara bul komutu ve karşılaştırma yardım lütfen

  • Konbuyu başlatan Konbuyu başlatan infom
  • Başlangıç tarihi Başlangıç tarihi
Katılım
5 Ekim 2012
Mesajlar
19
Excel Vers. ve Dili
2007
Excel web tr kardeşlerime selam ediyorum. Gerçekten burdaki güzellikler ve hazineler biz bilmeyenlerin işini o kadar kolaylaştırıyor ki anlatamam.

Öncelikle birçok projede bizlerden yardımını esirgemeyen DeDe nickli kardeşime çoook teşekkür ederim. Zira bir önceki projemde bana çok destek oldu.

Arkadaşlar şimdi sorunumu anlatmak istiyorum, yardım eden veya edemeyen herkese teşekkür ederim. Çünkü bu satırları okuyan bir çok kardeşim yardım etmek için giriş yapmıştır. Sağolun.

Arkadaşlar elimde bir excel tablosu var. Bu tablo ile Satır sorgulaması yapmak ve bu isimleri sabah - öğleden sonra şeklinde ayırmak istiyorum. Sabah ve öğleden sonra diye ayırıp, daha sonra sayfa2 deki telefon numaralarını sayfa 3 te bulunan sabah ise sabah öğleden sonra ise öğleden sonra kutusunun karşısına yazmasını istiyoruz.

Teşekkür ederim.

Eke bakabilirseniz naçizane daha iyi anlarsınız beni.
 

Ekli dosyalar

Merhaba,
Dosyanız ilişiktedir.
Kod:
Sub aktar()
On Error Resume Next
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
Set s3 = Sheets("Sayfa3")
If s3.[B1] <> "" Then
    Set Aranan = s1.Range("B4:B" & s1.Range("B" & Rows.Count).End(3).Row).Find(s3.[B1].Value, , xlFormulas, xlWhole)
    If Not Aranan Is Nothing Then
        sk = s1.Rows(Aranan.Row).Find("*", , , , xlByColumns, xlPrevious).Column
        For i = 4 To sk Step 2
            ss = s3.Range("A" & Rows.Count).End(3).Row + 1
            s3.Cells(ss, 1).Value = Split(s1.Cells(Aranan.Row, i).Value, "-")(1)
                Set Aranan1 = s2.Range("A:A").Find(s3.Cells(ss, 1).Value, , xlValues, xlWhole)
                If Not Aranan1 Is Nothing Then s3.Cells(ss, 2).Value = s2.Cells(Aranan1.Row, 2).Value
            s3.Cells(ss, 3).Value = Split(s1.Cells(Aranan.Row, i + 1).Value, "-")(1)
                Set Aranan2 = s2.Range("A:A").Find(s3.Cells(ss, 3).Value, , xlValues, xlWhole)
                If Not Aranan2 Is Nothing Then s3.Cells(ss, 4).Value = s2.Cells(Aranan2.Row, 2).Value
        Next i
    End If
End If
MsgBox "Aktarma İşlemi Tamamlandı.", vbInformation, "dEdE " & Application.UserName & "'e Başarılar diler."
End Sub
 

Ekli dosyalar

DeDemmm Allah cc razı olsun senden. İnan bizi öyle sevindirdin ki; Rabbim cc ilmini arttırsın. Çok Teşekkür ederim.

Yalnız ben tek sayfa göstermiştim lakin bu format dört sayfadan oluşuyor :( tarihler soldan aşağı doğru iniyor sağ tarafta da sınıflar var. Yani U sütunu ve 36 satıra kadar sınıf var.
 
Son düzenleme:
... ben tek sayfa göstermiştim lakin bu format dört sayfadan oluşuyor :( tarihler soldan aşağı doğru iniyor sağ tarafta da sınıflar var. Yani U sütunu ve 36 satıra kadar sınıf var.

Merhaba,
Kod satır ve sutun sayısından bağımsız olarak yazılmıştır. Yani ne kadar satır ve sutun olursa olsun bunu algılar ve işlem yapar. Asıl dosyanızda denediniz mi?
Eğer hatalı işlem yapıyorsa asıl dosyanızın satır ve sütun yapısının örnek dosyanıza uymamasındandır.
ÖZET: Bilgiler aynı satır ve aynı sütunda ise satır sayısı ve sütun sayısı sorun çıkarmaz.
 
Geri
Üst