Ana hesap kodlarının sayfalarda gösterilmesi

[1903emre34@gmail.com]

Merhaba,

Anahesap (K sütünü), ilk üç haneli koda göre ayrı ayrı sayfalarda gözükmesi için kod oluşturabilir miyiz, istenen 600 ve 621 sayfalarda yapılmıştır.

 

[ÖmerFaruk]

600-621 gibi sayfalar mevcut mu yoksa, her farklı ana hesap için yeni sayfa açılarak o sayfaya mı kaydedilecek?

 

[1903emre34@gmail.com]

600-621 gibi sayfalar mevcut değil, original sadece sayfa1 mevcut, her farklı ana hesap için yeni sayfa açılacak.

 

[Greenblacksea53]

Böyle bir şey mi istediniz ?

 

[ÖmerFaruk]

Aşağıdaki kodları boş bir Module ekleyip çalıştırabilirsiniz.

Özellikler
1. Sayfalar varsa dahi önce sayfayı siliyor sonra yeniden oluşturuyor.
2. Ana listenin hemen arkasındaki sayfaya HesapKodu sayfalarını küçükten büyüğe doğru sıralıyor.

Sub AnaHesapSayfalar()
   Dim Dict As Object
   Arr = Worksheets("Sayfa1").Range("A1:L" & Worksheets("Sayfa1").Range("A" & Rows.Count).End(3).Row).Value
   If UBound(Arr) < 2 Then Exit Sub
 
   Set Dict = CreateObject("Scripting.Dictionary")
   For i = 2 To UBound(Arr)
      If Not Dict.Exists(Left(Arr(i, 11), 3)) Then Dict.Add Left(Arr(i, 11), 3), 1
   Next i
   Set SortArr = CreateObject("System.Collections.ArrayList")
   For Each Key In Dict
      SortArr.Add Key
   Next
   SortArr.Sort
   On Error Resume Next
   Application.DisplayAlerts = False
   For i = 1 To SortArr.Count
      Worksheets(SortArr(i - 1)).Delete
      If i = 1 Then
         Sheets.Add(After:=Sheets("Sayfa1")).Name = SortArr(i - 1)
      Else
         Sheets.Add(After:=Sheets(SortArr(i - 2))).Name = SortArr(i - 1)
      End If
      ReDim NewList(1 To UBound(Arr), 1 To UBound(Arr, 2))
      Say = 0
      For k = 1 To UBound(Arr)
         If k = 1 Or Left(Arr(k, 11), 3) = SortArr(i - 1) Then
            Say = Say + 1
            For x = 1 To UBound(Arr, 2)
               NewList(Say, x) = Arr(k, x)
            Next x
         End If
      Next k
      Sheets(SortArr(i - 1)).Range("A1").Resize(UBound(NewList, 1), UBound(NewList, 2)) = NewList
      Sheets(SortArr(i - 1)).Cells.NumberFormat = Worksheets("Sayfa1").Cells.NumberFormat
   Next i
   Application.DisplayAlerts = True
   On Error GoTo 0
End Sub

 

[ÖmerFaruk]

Böyle bir şey mi istediniz ?

Kodlarınızda güzel bir fonksiyon var.

Function SayfaVarMi(SayfaAdi As String) As Boolean
    On Error Resume Next
    SayfaVarMi = CBool(Len(Worksheets(SayfaAdi).Name) > 0)
End Function

Ancak On Error Resume Next kullanırken dikkat etmeli, kodların bitiminde
On Error Goto 0 ile normal duruma almalısınız ki farklı dosyalar farklı kodlar düzgün çalışabilsin.

 

[Greenblacksea53]

Kodlarınızda güzel bir fonksiyon var.

Function SayfaVarMi(SayfaAdi As String) As Boolean
    On Error Resume Next
    SayfaVarMi = CBool(Len(Worksheets(SayfaAdi).Name) > 0)
End Function

Ancak On Error Resume Next kullanırken dikkat etmeli, kodların bitiminde
On Error Goto 0 ile normal duruma almalısınız ki farklı dosyalar farklı kodlar düzgün çalışabilsin.

Çok teşekkür ederim hocam , haklısınız siz kodları global düşünüyorsunuz ben daha hata varsa geç modundayım, excel'de yeniyim sayılır, uyarınız bana bişey öğrenmeme vesile oldu tşklr

 

[ÖmerFaruk]

Eyvallah.
Görüyor ve izliyorum.
Bol bol farklı arkadaşların soru çözümlerini ve kodlarını inceledikçe hızla mesafe katedeceğinize eminim.

 

[1903emre34@gmail.com]

Teşekkürler, her iki kod çalıştı.