Çözüldü Tüm satıra bölme işlemi

[KoNFiCuS]

Merhaba Üstadlar,

VBA da tek tek değil seçilecek range i komple bölmenin bir örneği var mı?

Mesela, A da AA yada kadar rakamlarım var, ben

A5:AA5 arasını komple 2 ye bölmek istiyorum. Sanki özel yapıştır, değerleri böl deki işlem gibi. Böyle devam edecek;
A6:AA6 / 2, A7:AA7 / 2 ta ki boş hücreye gelene kadar.

Teşekkürler

 

[Necdet]

Merhaba.

Aşağıdaki kod seçili alanda nümeric olan verileri 2 ye böler.
Siz kendinize göre uyarlayınız.

Public Sub Deneme()

Dim rng As Range

Application.ScreenUpdating = False

For Each rng In Selection
    If IsNumeric(rng) Then rng = rng / 2
Next rng

Application.ScreenUpdating = True

End Sub

 

[KoNFiCuS]

Merhaba.

Aşağıdaki kod seçili alanda nümeric olan verileri 2 ye böler.
Siz kendinize göre uyarlayınız.

Public Sub Deneme()

Dim rng As Range

For Each rng In Selection
    If IsNumeric(rng) Then rng = rng / 2
Next rng

End Sub

Necdet bey,

Cevabınız için teşekkür ederim ama yine tek tek işlem yapmakta, komple satırda işlem yapmıyor.

 

[Necdet]

Merhaba,
Eleştirinizi anlamadım, üzgünüm.

 

[KoNFiCuS]

@Necdet bey, eleştiri değil pardon,

İşlemi her hücre için yapıyor, mesela önce C2 yi bölüyor, D2 yi bölüyor, E2 yi bölüyor.

Varmıdır bir yolu bilmiyorum demek istediğim, sanki özel yapıştır böl deki gibi c2 den H2 ye kadar seçip herşeyi bölen bir kod?

Sanırım yok.

Not: Bu tür bir kod isteme sebebim kaynak dosyam çok büyük, a1 den fb 1500 gibi bir alana sahip.

 

[Necdet]

Satır ya da sütunun tümünü birden yapsın demek anlamsız, kodlar tek tek çalışır.
ben size kodun saf halini yazdım.
siz Screen işlemlerini kısıtlarsanız kod daha hızlı çalışır sanki hepsini birden yapmış gibi olur.

Kodları yeniledim bir de bu haliyle kullanın.

 

[Necdet]

Bir başka kod, seçilen alanı diziye alarak işlem yapar. Deneyiniz.

Public Sub Deneme()

Dim arr As Variant

Dim i   As Long
Dim j   As Integer

arr = Selection.Value

For i = LBound(arr, 1) To UBound(arr, 1)
    For j = LBound(arr, 2) To UBound(arr, 2)
        If IsNumeric(arr(i, j)) Then arr(i, j) = arr(i, j) / 2
    Next j
Next i

Range(Selection(1, 1).Address).Resize(UBound(arr, 1), UBound(arr, 2)) = arr

End Sub

 

[Korhan Ayhan]

Alternatif;

Kopyala-Özel Yapıştır-Değerleri-Böl işleminin makro halidir. Bir yardımcı hücre kullanılmıştır. (AZ1 hücresi kullanılmıştır. Bu hücre sizde doluysa farklı bir boş hücre kullanabilirsiniz.)

Son dolu satır için A sütunu kullanılmıştır. sizde farklı ise Rng alanını dilediğiniz gibi değiştirebilirsiniz.

Alandaki elle girilmiş sayısal veriler dikkate alınmıştır.

Option Explicit

Sub All_Constants_Numeric_Range_Divide()
    Dim Rng As Range
    
    Application.ScreenUpdating = False
    Set Rng = Range("A1:AA" & Cells(Rows.Count, 1).End(3).Row).SpecialCells(2, 1)
    Range("AZ1") = 2
    Range("AZ1").Copy
    Rng.PasteSpecial xlPasteValues, xlPasteSpecialOperationDivide
    Range("AZ1").ClearContents
    Set Rng = Nothing
    Application.ScreenUpdating = True
    
    MsgBox "Bölme işlemi tamamlanmıştır.", vbInformation
End Sub

 

[KoNFiCuS]

Necdet hocam, Korhan hocam,

Çok teşekkürler, hemen deneyeceğim.

 

[KoNFiCuS]

Korhan hocamın verdiği tam işime yaradı, teşekkürler.