çalışma sayfası içindeki sheetleri fihristleme

[euphrates55]

merhaba, excel dosyamın içinde isimler ve sayısı değişken olabileceği de düşünülerek, içinde bulunan her sayfanın C2 hücresini altalta sıralayarak en başta olan indeks sayfasına fihristleyecek bir makro yazılabilir mi? her çalıştırdığımda değişken olacak şekilde...

 

[ÖmerBey]

Merhaba,
Evet, yazılabilir. indeks sayfasının neresine yazılacak bu fihrist.
Başka bir ek özellik olacak mı?

 

[euphrates55]

merhaba tekrar. aslında olmayan bir indeks sayfasını en başa oluşturacak ve B5 den aşağıya doğru sekme sırasına göre sıralayacak şekilde olursa süper olur. biraz daha ileri gidecek olursak, mümkünse (sekmelerim alfabetik sıralanıyor, daha önceki yardımlarla hallettim bunu) her baş harf grubunun başına da bir başlık fena olmaz.

 

[ÖmerBey]

Şu kodları bir deneyiniz:

Sub Fihrist()
On Error Resume Next
Dim x As Integer, a As Integer, F As Worksheet, bas As String
x = 5
Set F = Sheets("İndeks")
If F Is Nothing Then
    Set F = Sheets.Add(before:=Sheets(1))
    F.Name = "İndeks"
Else
    F.Move before:=Sheets(1)
    F.Range("B5:B" & Rows.Count).ClearContents
End If
For a = 2 To Sheets.Count
    If bas <> Left(Sheets(a).Range("C2"), 1) Then
        F.Cells(x, "B") = Left(Sheets(a).Range("C2"), 1)
        bas = Left(Sheets(a).Range("C2"), 1)
        x = x + 1
    End If
    F.Cells(x, "B") = Sheets(a).Range("C2")
    x = x + 1
Next
End Sub

 

[euphrates55]

yazdığınız şekli ile harika çalışıyor. fakat ben sekme isimleri değil de her sekmedeki c2 hücresinin adını listelesin istemiştim. bir diğer sorum da başlıkları değiştirmek istersem nasıl değiştireceğim.

 

[ÖmerBey]

Kodu C2 hücresi olacak şekilde güncelledim, ama başlıktan kastınız nedir, anlayamadım.

 

[euphrates55]

anlatayım hemen. öncelikle elinize sağlık. şimdi atladığım bir durum var sanırım. sekmeler alfabetik sıralı olsa da c2 deki isimler sıralı değil. dolayısı ile istediğim gruplanma sağlanmadı. aynı adla başlayan sekmeler kendi arasında gruplanacak ve c2 deki isim ne denk gelirse sırayla listelenecek. örnek olarak "ço" ile başlayıp devam eden sekmelerim ve "sa" ile başlayıp devamı farklı sekmelerim var. "ço" ile başlayanlar bir grup olacak ve bu grubun c2 hücresinde yazanlar listelenecek. bir diğer grup "sa" ile başlayanlar olacak ve bunların c2 si listelenecek. devamı çok önemli olmasa da olması halinde güzel olacak şekilde grupların başlarına başlık atılacak. başlıklar ise am=amasya ço=çorum or=ordu sa=samsun si=sinop to=tokat olacak. illeri ilk iki harfine göre kodladım.

 

[ÖmerBey]

Umarım bu sefer doğru anlamışımdır. Grup isimleri sekmenin ilk iki harfi, liste C2 hücresi.

Sub Fihrist()
On Error Resume Next
Dim x As Integer, a As Integer, F As Worksheet, bas As String
x = 5
Set F = Sheets("İndeks")
If F Is Nothing Then
    Set F = Sheets.Add(before:=Sheets(1))
    F.Name = "İndeks"
Else
    F.Move before:=Sheets(1)
    F.Range("B5:B" & Rows.Count).ClearContents
End If
For a = 2 To Sheets.Count
    If bas <> Left(Sheets(a).Name, 2) Then
        bas = Left(Sheets(a).Name, 2)
        F.Cells(x, "B") = bas
        x = x + 1
    End If
    F.Cells(x, "B") = Sheets(a).Range("C2")
    x = x + 1
Next
End Sub

 

[euphrates55]

çok doğru anladınız. başlıkları da artık elle düzeltirim o kolay. belki başlık hariç numaralandırma yapılabilir ama o da kolay. elinize sağlık.

 

[ÖmerBey]

Aşağıdaki kod satırlarını, mevcut kodların sonuna (Next ile End Sub satırının arasına) ilave edip deneyiniz.

bul = Array("am", "ço", "or", "sa", "si", "to")
deg = Array("Amasya", "Çorum", "Ordu", "Samsun", "Sinop", "Tokat")
For a = LBound(bul) To UBound(bul)
    F.Range("B5:B" & Rows.Count).Replace bul(a), deg(a), xlWhole
Next

 

[euphrates55]

teşekkürler...

 

[ÖmerBey]

Rica ederim, iyi çalışmalar...

 

[euphrates55]

Sub SayfaIndex()
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  If WorksheetExists("SayfaIndex") Then Sheets("SayfaIndex").Delete
  Set NewSh = Sheets.Add(Before:=Sheets(1))
  NewSh.Name = "SayfaIndex"

  Cells.ClearContents
  kolon = 1
  satir = 2
  Cells(1, 1).Select
  ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="SayfaIndex!A1", TextToDisplay:="SayfaIndex"
 
  For i = 2 To Sheets.Count
    Cells(satir, kolon).Value = Sheets(i).Name
    Sheets(i).Hyperlinks.Add Anchor:=Sheets(i).Cells(1, 1), Address:="", SubAddress:="SayfaIndex!A1", TextToDisplay:="SayfaIndex"
    ActiveSheet.Hyperlinks.Add Anchor:=Cells(satir, kolon), Address:="", SubAddress:="'" & Sheets(i).Name & "'!A1", TextToDisplay:=Sheets(i).Name
    satir = satir + 1
    If satir = 26 Then
       kolon = kolon + 1
       satir = 2
    End If
  Next i
 
  Cells.Select
  Cells.EntireColumn.AutoFit
  Range("E1").Select
 
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
End Sub

Public Function WorksheetExists(ByVal WorksheetName As String) As Boolean
   On Error Resume Next
   WorksheetExists = (Sheets(WorksheetName).Name <> "")
   On Error GoTo 0
End Function

kod sekme isimlerini alıyor. sayfaindex adında sekme oluşturuyor tüm sekmeleri listeliyor ve köprülüyor.

Sub Fihrist()
On Error Resume Next
Dim x As Integer, a As Integer, F As Worksheet, bas As String
x = 5
Set F = Sheets("İndeks")
If F Is Nothing Then
    Set F = Sheets.Add(before:=Sheets(1))
    F.Name = "İndeks"
Else
    F.Move before:=Sheets(1)
    F.Range("B5:B" & Rows.Count).ClearContents
End If
For a = 2 To Sheets.Count
    F.Cells(x, "B") = Sheets(a).Range("C2")
    x = x + 1
Next
End Sub

bu kod ise c2 deki isimleri alıyor ama köprülemiyor (linklemiyor.)
ben ise ikisinin karışımını istiyorum. linkleyecek ama c4 hücresindeki isim ile listeleyecek. bunun için ne yapmalıyım. muhtemelen 1. yazdığım kodda bir yere bir şey yazmam gerekiyor ama denediğim hiçbir şey olmadı. yardım edebilir misiniz.

 

[ÖmerBey]

İlk koddaki Cells(satir, kolon).Value = Sheets(i).Name satırını Cells(satir, kolon).Value = Sheets(i).Range("C4").Value ile değiştirip deneyiniz.

 

[euphrates55]

ek olarak TextToDisplay:=Sheets(i).Range("C4").Value yapınca oldu. sonunda...