• DİKKAT

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

puantaj düzenleme yardımı

S

sedat2161

Katılım
1 Ekim 2017
Mesajlar
694
Excel Vers. ve Dili
2019 türkçe
ekteki puantajda belirtiğim gibi aktar butonuna tıkladığımda cumartesi günleri:c pazar:p diğer günler: x olsun .yardımcı olursanız çok memenun olurum. saygılar
 

Ekli dosyalar

Aktar butonuna aşağıdaki kodu atayınız.

Kod: 
Sub CommandButton1_Click()
    Range("F6").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(WEEKDAY(R[-1]C,2)=6,""c"",IF(WEEKDAY(R[-1]C,2)=7,""p"",""x""))"
    Range("F6").Select
    Selection.AutoFill Destination:=Range("F6:AJ6"), Type:=xlFillDefault
        Range("F7").Select
    ActiveCell.FormulaR1C1 = "=R[-1]C"
    Range("F7").Select
    Selection.AutoFill Destination:=Range("F7:AJ7"), Type:=xlFillDefault
    Range("F7:AJ7").Select
    Selection.AutoFill Destination:=Range("F7:AJ17"), Type:=xlFillDefault
    Range("F7:AJ17").Select
    Range("F6:AJ17").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("R19").Select
End Sub
 
boş hücre sıfırlansın

sayın anemis ilginiz için çok teşekkür ederim. Çok güzel oldu yalnız başka bir sorun ile karşılaştım 31 günden az çeken günler örneğin 30 28 ve 29 çeken günlerde hücrede değer kalıyor sıfırlanırsa çok iyi olacak. ekte örnek var. saygılar.
 

Ekli dosyalar

Kodunuzu şu şekilde değişitiriniz;

Kod: 
Private Sub CommandButton1_Click()
Range("F6").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(R[-1]C="""","""",IF(WEEKDAY(R[-1]C,2)=6,""c"",IF(WEEKDAY(R[-1]C,2)=7,""p"",""x"")))"
    Range("F6").Select
    Selection.AutoFill Destination:=Range("F6:AJ6"), Type:=xlFillDefault
    Range("F6:AJ6").Select
    Range("F7").Select
    ActiveCell.FormulaR1C1 = "=R[-1]C"
    Range("F7").Select
    Selection.AutoFill Destination:=Range("F7:AJ7"), Type:=xlFillDefault
    Range("F7:AJ7").Select
    Selection.AutoFill Destination:=Range("F7:AJ17"), Type:=xlFillDefault
    Range("F7:AJ17").Select
    Range("F6:AJ17").Select
    With Selection
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AL2:AL3").Select
    Application.CutCopyMode = False
End Sub
 
Cumartesi pazar sütunu renkli olsun

Sayın anemis cumartesi ve pazar günlerine ait sütunlar renkli olabilirmi yeşil renk . Saygılar ekteki gibi
 

Ekli dosyalar

kişi bul

hayırlı sabahlar. ekte belirttiğim puantajda b3, c3, d3, e3 hücresine arama yapmak istiyorum. yardımcı olursanız çok sevinirim.
 

Ekli dosyalar

ara

sayın anemis benim bu puantajım 70 kişiden oluşuyor. örneğin isim yazğımda 30. kişi ilk satıra gelsin ve onun bilglerini gireyim. teşekkür ederim.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst