• DİKKAT

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

Numeric olmayan sayfa isimlerini saydırmak

S

s.savas

Katılım
12 Ocak 2009
Mesajlar
838
Excel Vers. ve Dili
2003
Merhaba arkadaşlar
Aşağıdaki kod ile sayfa isimleri numeric olanlar saydırılıyor.
Kod: 
Private Sub CommandButton1_Click()
Dim i As Integer, j As Integer, s As Worksheet, toplam As Double
Set s = Sheets("M.icmal")
j = 17
[B][COLOR="red"]For i = 1 To Sheets.Count[/COLOR]
[/B][COLOR="Red"][B]If IsNumeric(Sheets(i).Name) = True Then[/B][/COLOR]
s.Cells(j, "a").Value = j - 16
s.Cells(j, "a").Borders.LineStyle = 1
s.Cells(j, "a").HorizontalAlignment = xlCenter
s.Cells(j, "b").Value = Sheets(i).Range("a31").Value
s.Cells(j, "b").Borders.LineStyle = 1
s.Cells(j, "c").Value = Sheets(i).Range("e31").Value
s.Cells(j, "c").HorizontalAlignment = xlCenter
s.Cells(j, "c").Borders.LineStyle = 1
s.Cells(j, "d").Value = Sheets(i).Range("f31").Value
s.Cells(j, "d").HorizontalAlignment = xlCenter
s.Cells(j, "d").Borders.LineStyle = 1
s.Cells(j, "e").Value = Sheets(i).Range("g31").Value
s.Cells(j, "e").Borders.LineStyle = 1
s.Cells(j, "e").HorizontalAlignment = xlCenter
s.Cells(j, "f").Value = Sheets(i).Range("h31").Value
s.Cells(j, "f").Borders.LineStyle = 1
s.Cells(j, "f").HorizontalAlignment = xlCenter
s.Cells(j, "f").NumberFormat = "#,##0.00"
toplam = toplam + Sheets(i).Range("h34").Value

j = j + 1
End If
Next i

Şunu öğrenmek istiyorum. Sayfa isimleri numeric değilse nasıl saydırılır.
Örnek: A1,A2,A3
 
Merhaba,

If Not IsNumeric(Sheets(i).Name) = True

Mavi kodu ilave ediniz..

.

 
Kod: 
[B][COLOR=#ff0000]If IsNumeric(Sheets(i).Name) = True Then
[/COLOR][/B]

Yukarıdaki satırdaki "true" yerine "false" yazmanız yeterlidir.
 
Sn, Levent ve Ömer hocalarım ilginize teşekkür ediyorum.
İlk mesajımda sanırım eksik bilgi verdim, özür diliyorum.
Gayem ekteki H1,H2,H3,H4 ve H5 sekmelerinde bulunan bazı sabit verileri H.icmal sayfasına almak istiyorum.
Dolayısıyla
Kod: 
If Not IsNumeric(Sheets(i).Name) = True
veya true'nin false olması, belgede nümerik olmayan diğer sayfalarıda sayabileceğinden kod doğru sonuç vermeyecek veya hata verecebilecektir. Yanlışmı düşünüyorum.
 

Ekli dosyalar

Kodu aşağıdaki gibi değiştirince çok alakasız veri alıyor.
Kod: 
Private Sub CommandButton1_Click()
Dim i As Integer, j As Integer, s As Worksheet, toplam As Double
Set s = Sheets("H.icmal")
j = 17
For i = 1 To Sheets.Count
If IsNumeric(Sheets(i).Name) = False Then

s.Cells(j, "J").Value = Sheets(i).Range("F41").Value

j = j + 1
End If
Next i

s.Cells(j + 11, "a").Value = "Komisyon Başkanı"
s.Cells(j + 11, "a").Font.Bold = True
s.Cells(j + 11, "h").Value = "Üye"
s.Cells(j + 11, "h").Font.Bold = True
s.Cells(j + 11, "k").Value = "Üye"
s.Cells(j + 11, "k").Font.Bold = True
s.Cells(j + 12, "a").Value = Sheets("Menü").Cells(6, "b").Value
s.Cells(j + 12, "h").Value = Sheets("Menü").Cells(7, "b").Value
s.Cells(j + 12, "k").Value = Sheets("Menü").Cells(8, "b").Value
s.Cells(j + 13, "a").Value = Sheets("Menü").Cells(6, "c").Value
s.Cells(j + 13, "h").Value = Sheets("Menü").Cells(7, "c").Value
s.Cells(j + 13, "k").Value = Sheets("Menü").Cells(8, "c").Value
End Sub

Örnek olarak H.icmal sayfasına H1,H2,H3,H4 ve H5 sekmelerindeki
J17=H1!F41
J18=H2!F41
J19=H3!F41
J20=H4!F41
J21=H5!F41

K17=H1!F43
K18=H2!F43
K19=H3!F43
K20=H4!F43
K21=H5!F43
verileri almak istiyorum.

Yukarıdaki kod Şablon veya endeks sayfalarından alakasız veriler alıyor.
 
Merhaba,
İsteğinizi doğru anladıysam eğer aşağıdaki şekilde kodu kullanabilirsiniz.
Kod: 
Private Sub CommandButton1_Click()
Dim i As Integer, j As Integer, s As Worksheet, toplam As Double
Set s = Sheets("H.icmal")
j = 17
For i = 1 To 5
s.Cells(j, "J").Value = Sheets("H" & i).Range("F41").Value
j = j + 1
Next i
s.Cells(j + 11, "a").Value = "Komisyon Başkanı"
s.Cells(j + 11, "a").Font.Bold = True
s.Cells(j + 11, "h").Value = "Üye"
s.Cells(j + 11, "h").Font.Bold = True
s.Cells(j + 11, "k").Value = "Üye"
s.Cells(j + 11, "k").Font.Bold = True
s.Cells(j + 12, "a").Value = Sheets("Menü").Cells(6, "b").Value
s.Cells(j + 12, "h").Value = Sheets("Menü").Cells(7, "b").Value
s.Cells(j + 12, "k").Value = Sheets("Menü").Cells(8, "b").Value
s.Cells(j + 13, "a").Value = Sheets("Menü").Cells(6, "c").Value
s.Cells(j + 13, "h").Value = Sheets("Menü").Cells(7, "c").Value
s.Cells(j + 13, "k").Value = Sheets("Menü").Cells(8, "c").Value
End Sub
 
Selamlar,

İstediğiniz bölümü döngü kurmadanda alabilirsiniz.

Kod: 
Option Explicit
 
Sub AKTAR()
    With Sheets("H.icmal")
        .Range("J17") = Sheets("H1").Range("F41")
        .Range("J18") = Sheets("H2").Range("F41")
        .Range("J19") = Sheets("H3").Range("F41")
        .Range("J20") = Sheets("H4").Range("F41")
        .Range("J21") = Sheets("H5").Range("F41")
        
        .Range("K17") = Sheets("H1").Range("F43")
        .Range("K18") = Sheets("H2").Range("F43")
        .Range("K19") = Sheets("H3").Range("F43")
        .Range("K20") = Sheets("H4").Range("F43")
        .Range("K21") = Sheets("H5").Range("F43")
    End With
End Sub
 
Teşekkür ederim değerli hocalarım. Ellerinize ve emeğinize sağlık.
 
Günaydın arkadaşlar.
Aşağıdaki renklendirilen kod örnek1 de çalışıyor, örnek2 de çalışmıyor.
Hatanın kaynağını bulamadım.

Kod: 
Private Sub CommandButton1_Click()
Dim i As Integer, j As Integer, s As Worksheet, toplam As Double
Set s = Sheets("H.icmal")
j = 17
For i = 1 To 5
s.Cells(j, "I").Value = Sheets("H" & i).Range("F33").Value
s.Cells(j, "H").Value = Sheets("H" & i).Range("F34").Value
s.Cells(j, "J").Value = Sheets("H" & i).Range("F42").Value
s.Cells(j, "K").Value = Sheets("H" & i).Range("F44").Value
[COLOR="Blue"][B][I22].Value = WorksheetFunction.Sum(s.Range("I17:I21")) & " Adet"[/B][/COLOR]
[B][COLOR="blue"][J22].Value = FormatCurrency(WorksheetFunction.Sum(s.Range("j17:j21")))[/COLOR][/B]
[B][COLOR="blue"][k22].Value = FormatCurrency(WorksheetFunction.Sum(s.Range("k17:k21")))[/COLOR][/B]

j = j + 1
Next i
s.Cells(j + 4, "a").Value = ("          İdaremizin " & Sheets("Menü").Cells(11, "b").Value & "  tarih ve " & Sheets("Menü").Cells(12, "b").Value & " sayılı görevlendirmesi sonucu ilgide kayıtlı hizmet alımının Brüt Asgari Ücret")
s.Cells(j + 5, "a").Value = ("Brüt Asgari Ücret üzerinden hesaplanan %18,5 SSK İşveren Payı, %1 Sigorta Risk Prim Oranı, %2 İşveren İşsizlik Sigorta")
s.Cells(j + 6, "a").Value = ("Fonu, Yol Gideri, Giyim Gideri, Resmi Tatil Ücreti," & "%" & Sheets("sabitler").Cells(6, "E").Value & " ve" & Sheets("sabitler").Cells(11, "E").Value & "firma karı olmak üzere yaklaşık maliyetin")
s.Cells(j + 7, "a").Value = (Format(s.Cells(j, "K").Value, "#,##0.00") & "-TL olduğu tespit edilmiştir.")


s.Cells(j + 11, "a").Value = "Komisyon Başkanı"
s.Cells(j + 11, "a").Font.Bold = True
s.Cells(j + 11, "h").Value = "Üye"
s.Cells(j + 11, "h").Font.Bold = True
s.Cells(j + 11, "k").Value = "Üye"
s.Cells(j + 11, "k").Font.Bold = True
s.Cells(j + 12, "a").Value = Sheets("Menü").Cells(6, "b").Value
s.Cells(j + 12, "h").Value = Sheets("Menü").Cells(7, "b").Value
s.Cells(j + 12, "k").Value = Sheets("Menü").Cells(8, "b").Value
s.Cells(j + 13, "a").Value = Sheets("Menü").Cells(6, "c").Value
s.Cells(j + 13, "h").Value = Sheets("Menü").Cells(7, "c").Value
s.Cells(j + 13, "k").Value = Sheets("Menü").Cells(8, "c").Value
End Sub
 

Ekli dosyalar

Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst