• DİKKAT

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

select kodundaki yavaşlamayı engellemek için nasıl değişiklik yapabilirim.

U

udentr2002

Altın Üye
Katılım
5 Kasım 2006
Mesajlar
1,503
Excel Vers. ve Dili
iş yerinde Office 365
evde Office 365
Merhaba arkadaşlar,

Aşağıda ki kodda select kodu olduğundan çok yavaşlatıyor bunun yerine nasıl düzenleyebilrim, değiştirebilrim. select yaptığı sayfanın adı "Kriterleri Belirleme"

Kod: 
Range("E12:E13").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    With Selection
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With

Yardımcı olursanız çok sevinirim.

Yukarıdaki kod gibi çok olunca ciddi anlamda yavaşlamasına sebep oluyor.
 
Kodla neyi hedefliyorsunuz?
Kod: 
Range("E12:E13").Merge
 
Hocam ilginiz için teşekkürler.

Kodlar yardımı ile ilgili alan yazılan verinin biçimini formmatını gibi özelliklerini düzenlemeye çalışıyorum. Kodunun tamamını göndereyim. Dediğim gibi select kodunu kullanınca ciddi anlamda yavaşlama oluyor.

Kod: 
Private Sub cmdKriter_Click()

s1 = "Ürün Bilgileri"
s2 = "Kriterleri Belirleme"

    Sheets(s2).Range("B7:P7").ClearContents
   
   Sheets(s2).Range("E8:H16").ClearContents
    
    Sheets(s2).Range("M8:O16").ClearContents
    

If cmbBiten.Value = "" Then
MsgBox ("Üretimi biten ürünü seçiniz..")
ElseIf cmbUretilecek.Value = "" Then
MsgBox ("Üretilecek ürünü seçiniz..")
ElseIf cmbBiten.Value = "" And cmbUretilecek.Value = "" Then
MsgBox ("Üretimi biten ve üretilecek ürünleri seçiniz..")
ElseIf cmbBiten.Value <> "" And cmbUretilecek.Value <> "" Then

For i = 0 To 1000

If (Sheets(s1).Cells(15 + i, 3) = cmbBiten.Value) Then
etkenBiten = Sheets(s1).Cells(15 + i, 2)
urunBiten = Sheets(s1).Cells(15 + i, 3)
minDozBiten = Sheets(s1).Cells(15 + i, 7)
maxDozBiten = Sheets(s1).Cells(15 + i, 9)
tbAgirlikBiten = Sheets(s1).Cells(15 + i, 11)
ftbAgirlikBiten = Sheets(s1).Cells(15 + i, 13)
tbSeriBiten = Sheets(s1).Cells(15 + i, 15)
ftbSeriBiten = Sheets(s1).Cells(15 + i, 17)
seriBoyuBiten = Sheets(s1).Cells(15 + i, 19)
End If

Next


For i = 0 To 1000

If (Sheets(s1).Cells(15 + i, 3) = cmbUretilecek.Value) Then
etkenUretilecek = Sheets(s1).Cells(15 + i, 2)
urunUretilecek = Sheets(s1).Cells(15 + i, 3)
minDozUretilecek = Sheets(s1).Cells(15 + i, 7)
maxDozUretilecek = Sheets(s1).Cells(15 + i, 9)
tbAgirlikUretilecek = Sheets(s1).Cells(15 + i, 11)
ftbAgirlikUretilecek = Sheets(s1).Cells(15 + i, 13)
tbSeriUretilecek = Sheets(s1).Cells(15 + i, 15)
ftbSeriUretilecek = Sheets(s1).Cells(15 + i, 17)
seriBoyuUretilecek = Sheets(s1).Cells(15 + i, 19)
End If

Next

'Biten Ürün Bilgileri
Sheets(s2).Cells(7, 2) = urunBiten
Sheets(s2).Cells(8, 5) = minDozBiten
Sheets(s2).Cells(8, 6) = "mg"
Sheets(s2).Cells(9, 5) = etkenBiten
Sheets(s2).Cells(10, 5) = "1 tablet"
Sheets(s2).Cells(11, 5) = maxDozBiten
Sheets(s2).Cells(11, 6) = "mg"


If (ftbAgirlikBiten = 0) Then

 With Range("E12:E13").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    With Selection
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Range("F12:F13").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With

Sheets(s2).Cells(12, 5) = tbAgirlikBiten
Sheets(s2).Cells(12, 6) = "mg"

Range("E14:E15").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    With Selection
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Range("F14:F15").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With

Sheets(s2).Cells(14, 5) = tbSeriBiten
Sheets(s2).Cells(14, 6) = "kg"

ElseIf (ftbAgirlikBiten <> 0) Then

    Range("E12:E13").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Selection.UnMerge
    Range("F12:F13").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Selection.UnMerge

    Range("E14:E15").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Selection.UnMerge
    Range("F14:F15").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Selection.UnMerge

Sheets(s2).Cells(12, 5) = tbAgirlikBiten
Sheets(s2).Cells(12, 6) = "mg"
Sheets(s2).Cells(12, 7) = "(Tb.)"
Sheets(s2).Cells(13, 5) = ftbAgirlikBiten
Sheets(s2).Cells(13, 6) = "mg"
Sheets(s2).Cells(13, 7) = "(Ftb.)"
Sheets(s2).Cells(14, 5) = tbSeriBiten
Sheets(s2).Cells(14, 6) = "kg"
Sheets(s2).Cells(14, 7) = "(Tb.)"
Sheets(s2).Cells(15, 5) = ftbSeriBiten
Sheets(s2).Cells(15, 6) = "kg"
Sheets(s2).Cells(15, 7) = "(Ftb.)"

End If

Sheets(s2).Cells(16, 5) = seriBoyuBiten
Sheets(s2).Cells(16, 6) = "tablet"


'Üretilecek Ürün Bilgileri
Sheets(s2).Cells(7, 10) = urunUretilecek
Sheets(s2).Cells(8, 13) = minDozUretilecek
Sheets(s2).Cells(8, 14) = "mg"
Sheets(s2).Cells(9, 13) = etkenUretilecek
Sheets(s2).Cells(10, 13) = "1 tablet"
Sheets(s2).Cells(11, 13) = maxDozUretilecek
Sheets(s2).Cells(11, 14) = "mg"

If (ftbAgirlikUretilecek = "") Then

 Range("M12:M13").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    With Selection
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Range("N12:N13").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With

Sheets(s2).Cells(12, 13) = tbAgirlikUretilecek
Sheets(s2).Cells(12, 14) = "mg"

Range("M14:M15").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    With Selection
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Range("N14:N15").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With

Sheets(s2).Cells(14, 13) = tbSeriUretilecek
Sheets(s2).Cells(14, 14) = "kg"


ElseIf (ftbAgirlikUretilecek <> "") Then

    Range("M12:M13").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Selection.UnMerge
    Range("N12:N13").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Selection.UnMerge
    
     Range("M14:M15").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Selection.UnMerge
    Range("N14:N15").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Selection.UnMerge

Sheets(s2).Cells(12, 13) = tbAgirlikUretilecek
Sheets(s2).Cells(12, 14) = "mg"
Sheets(s2).Cells(12, 15) = "(Tb.)"
Sheets(s2).Cells(13, 13) = ftbAgirlikUretilecek
Sheets(s2).Cells(13, 14) = "mg"
Sheets(s2).Cells(13, 15) = "(Ftb.)"
Sheets(s2).Cells(14, 13) = tbSeriUretilecek
Sheets(s2).Cells(14, 14) = "kg"
Sheets(s2).Cells(14, 15) = "(Tb.)"
Sheets(s2).Cells(15, 13) = ftbSeriUretilecek
Sheets(s2).Cells(15, 14) = "kg"
Sheets(s2).Cells(15, 15) = "(Ftb.)"

End If

Sheets(s2).Cells(16, 13) = seriBoyuUretilecek
Sheets(s2).Cells(16, 14) = "tablet"


    Range("E12:P16").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .Name = "Times New Roman"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With

    Range("B4:P4").Select

'Safsızlık Kalıntı Kriteri

If (maxDozUretilecek > 1000) Then
terapatikDoz1 = (maxDozUretilecek * 0.05) / 100
Sheets(s2).Cells(23, 5) = maxDozUretilecek & " mg > 1 g --> %0,05"
kriter1 = terapatikDoz1 * seriBoyuUretilecek
Sheets(s2).Cells(24, 5) = maxDozUretilecek & " * 0,05 / 100 = " & terapatikDoz1 & " mg " & urunBiten & " / " & urunUretilecek
Sheets(s2).Cells(25, 5) = terapatikDoz1 & " * " & seriBoyuUretilecek & " = " & kriter1 & " mg / seri"

ElseIf (maxDozUretilecek <= 1000) Then
terapatikDoz1 = (maxDozUretilecek * 0.1) / 100
Sheets(s2).Cells(23, 5) = maxDozUretilecek & " mg <= 1 g --> %0,1"
kriter1 = terapatikDoz1 * seriBoyuUretilecek
Sheets(s2).Cells(24, 5) = maxDozUretilecek & " * 0,1 / 100 = " & terapatikDoz1 & " mg " & urunBiten & " / " & urunUretilecek
Sheets(s2).Cells(25, 5) = terapatikDoz1 & " * " & seriBoyuUretilecek & " = " & kriter1 & " mg / seri"

End If


'Etkinlik Kriteri
terapatikDoz2 = maxDozBiten / 1000
Sheets(s2).Cells(30, 5) = maxDozBiten & " / 1000 = " & terapatikDoz2 & " mg " & urunBiten & " / " & urunUretilecek
kriter2 = terapatikDoz2 * seriBoyuUretilecek
Sheets(s2).Cells(31, 5) = terapatikDoz2 & " * " & seriBoyuUretilecek & " = " & kriter2 & " mg / seri"


'Risk Kriteri
kriter3 = maxDozBiten
Sheets(s2).Cells(35, 5) = kriter3 & " mg / seri"


End If

End Sub

Ben
with sheets(s2).range("e12:13")
.
.
.
Şeklinde denedim ama bu defada if hatası verdi bir kaç gündürlü uğraşıyorum çözemedim. Tek amacım kod çalışırken sayfadaki alanları seçip kodu çalıştırmasın select kodu çok yavaşlatıyor.

Kod uzun ama kusura bakmayın tekrar ilgilenebilirseniz çok sevinirim.

SAYGILARIMLA
 
Üstat gerek kalmadı.

Tüm kodları kaldırdım. Biçimlendirme yapmasına gerek yok.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst