• DİKKAT

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

Makro Kaydet Yolu ile Yapılan Makronun Boş Satırda İşlem Yapmasını Durduramıyorum

B

bilal5412

Katılım
12 Nisan 2011
Mesajlar
190
Excel Vers. ve Dili
2010-TR
Merhaba arkadaşlar,

Makro kaydet yolu ile yaptığım makro boş satırlar içinde işlem yapmaktadır. Nasıl durdurabiliriz. Yardımcı olur musunuz.

A hücresini baz alabilirsiniz. A hücresi boş ise makro işlem yapmasın.

Kod: 
Sub malzkontr()
'
' malzkontr Makro
'

'
    Columns("N:S").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("N1").Select
    ActiveCell.FormulaR1C1 = "sd"
    Range("O1").Select
    ActiveCell.FormulaR1C1 = "öner"
    Range("P1").Select
    ActiveCell.FormulaR1C1 = "ay"
    Range("Q1").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("R1").Select
    ActiveCell.FormulaR1C1 = "2"
    Range("S1").Select
    ActiveCell.FormulaR1C1 = "3"
    Columns("N:S").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("N2").Select
    ActiveCell.FormulaR1C1 = "=SUM(RC[-8]:RC[-3])-RC[-2]"
    Range("P2").Select
    
    ActiveCell.FormulaR1C1 = "=(RC[6]+RC[7])/(12+MONTH(TODAY()))"
    Range("Q2").Select
    ActiveCell.FormulaR1C1 = "=RC[-3]-RC[-1]"
    Range("R2").Select
    ActiveCell.FormulaR1C1 = "=RC[-1]-RC[-2]"
    Range("S2").Select
    ActiveCell.FormulaR1C1 = "=RC[-1]-RC[-3]"
    Range("N2:S2").Select
    Selection.AutoFill Destination:=Range("N2:S42356")
    Range("N2:S42356").Select
    
    Calculate
    Columns("P:P").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("P1").Select
    ActiveCell.FormulaR1C1 = "açıklama"
    Cells.Select
    Range("D1").Activate
    Calculate
    Range("O1").Select
   
    Cells.Select
    With Selection.Font
        .Name = "Calibri"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    With Selection.Font
        .Name = "Calibri"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Selection.RowHeight = 15
    Range("F1").Select
    ActiveCell.FormulaR1C1 = "ta"
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "püd"
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "kurt"
    Range("I1").Select
    ActiveCell.FormulaR1C1 = "aks"
    Columns("F:I").Select
    Columns("F:I").EntireColumn.AutoFit
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("J:N").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.ColumnWidth = 8.43
    Columns("J:N").EntireColumn.AutoFit
    Range("O2").Select
    
End Sub
 
Son düzenleme:
Verdiğiniz kodlardan ne yapmak istediğiniz anlaşılamıyor.

Öncelikle ne yapmak istediğinizi mümkünse bir örnek dosya ekleyerek açıklayınız.
 
dalgalikur' Alıntı:
Verdiğiniz kodlardan ne yapmak istediğiniz anlaşılamıyor.

Öncelikle ne yapmak istediğinizi mümkünse bir örnek dosya ekleyerek açıklayınız.
Genişletmek için tıkla ...

Merhaba, aşağıdaki bağlantıda örnek çalışmam mevcuttur. Yaptığım işlemler bir kaç matematik işlemlerden oluşuyor. Ama makro boş satırlarda da işlem yaptığımdan nasıl durdurabilirim bilmiyorum. Saygılar.

https://drive.google.com/file/d/0B3wJKQcxKCV4dnNFTXFXbDJSRUE/view
 
. . .

A sütununda satırlar alt alta dolu mu oluyor yoksa
arada boşluklarda olabilir mi.

. . .
 
Şu kodları kullanın.

Kod: 
Sub Hesapla_Ekle()
    Dim Bak As Long
    
    Columns("N:T").Insert
    Range("N1").Value = "sd"
    Range("O1").Value = "öner"
    Range("P1").Value = "açıklama"
    Range("Q1").Value = "ay"
    Range("R1").Value = "1"
    Range("S1").Value = "2"
    Range("T1").Value = "3"
    
    For Bak = 2 To Cells(Rows.Count, "A").End(3).Row
        Range("N" & Bak).Value = Range("F" & Bak).Value + Range("G" & Bak).Value + _
            Range("H" & Bak).Value + Range("I" & Bak).Value + Range("J" & Bak).Value + _
            Range("K" & Bak).Value - Range("L" & Bak).Value
        Range("Q" & Bak).Value = (Range("W" & Bak).Value + Range("X" & Bak).Value) / (12 + Month(Date))
        
        Range("R" & Bak).Value = Range("N" & Bak).Value - Range("Q" & Bak).Value
        Range("S" & Bak).Value = Range("R" & Bak).Value - Range("Q" & Bak).Value
        Range("T" & Bak).Value = Range("S" & Bak).Value - Range("Q" & Bak).Value
        
        
        If Range("N" & Bak).Value < 0 Then Range("N" & Bak).Font.Color = ColorConstants.vbRed
        If Range("Q" & Bak).Value < 0 Then Range("N" & Bak).Font.Color = ColorConstants.vbRed
        If Range("R" & Bak).Value < 0 Then Range("N" & Bak).Font.Color = ColorConstants.vbRed
        If Range("S" & Bak).Value < 0 Then Range("N" & Bak).Font.Color = ColorConstants.vbRed
        If Range("T" & Bak).Value < 0 Then Range("N" & Bak).Font.Color = ColorConstants.vbRed
    Next
    
End Sub
 
dalgalikur' Alıntı:
Şu kodları kullanın.

Kod: 
Sub Hesapla_Ekle()
    Dim Bak As Long
    
    Columns("N:T").Insert
    Range("N1").Value = "sd"
    Range("O1").Value = "öner"
    Range("P1").Value = "açıklama"
    Range("Q1").Value = "ay"
    Range("R1").Value = "1"
    Range("S1").Value = "2"
    Range("T1").Value = "3"
    
    For Bak = 2 To Cells(Rows.Count, "A").End(3).Row
        Range("N" & Bak).Value = Range("F" & Bak).Value + Range("G" & Bak).Value + _
            Range("H" & Bak).Value + Range("I" & Bak).Value + Range("J" & Bak).Value + _
            Range("K" & Bak).Value - Range("L" & Bak).Value
        Range("Q" & Bak).Value = (Range("W" & Bak).Value + Range("X" & Bak).Value) / (12 + Month(Date))
        
        Range("R" & Bak).Value = Range("N" & Bak).Value - Range("Q" & Bak).Value
        Range("S" & Bak).Value = Range("R" & Bak).Value - Range("Q" & Bak).Value
        Range("T" & Bak).Value = Range("S" & Bak).Value - Range("Q" & Bak).Value
        
        
        If Range("N" & Bak).Value < 0 Then Range("N" & Bak).Font.Color = ColorConstants.vbRed
        If Range("Q" & Bak).Value < 0 Then Range("N" & Bak).Font.Color = ColorConstants.vbRed
        If Range("R" & Bak).Value < 0 Then Range("N" & Bak).Font.Color = ColorConstants.vbRed
        If Range("S" & Bak).Value < 0 Then Range("N" & Bak).Font.Color = ColorConstants.vbRed
        If Range("T" & Bak).Value < 0 Then Range("N" & Bak).Font.Color = ColorConstants.vbRed
    Next
    
End Sub
Genişletmek için tıkla ...

Yardımlarınız için çok teşekkür ederim. Sorum çözülmüştür. Bu kodlar makrodan daha hızlı çalışmaktadır. Saygılar. Selamlar.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst