Makro ile Sütuna Fonksiyon Atama

[Lucky1905]

Merhaba arkadaslar,

Benim kendi yaptigim bir fonksiyon var, bu fonksiyonu her hücreye tek tek vermek istemiyorum.
Bunu bir sütundaki bütün hücrelere nasil atayabiliriz?

Mesela fonksiyonum su, ben bunu B2 ye yaziyorum. Yani A2 nin icindeki biseyleri toplayip bana veriyor.
Simdi bunu direk assaya cektigim zaman C2 icinde otomatik aliyor ama ben bunu sinirsiz yapmak istiyorum. Sütunda komple olsun diye.
=MSUMME(A2;",")

Yardimci olabilecek biri olursa sevinirim.

Tesekkürler.

 

[Lucky1905]

Bir ekleme yapayim.
A sütunundaki 1. hücre harici bütün hücrelere uygulamak istiyorum.

 

[Lucky1905]

Autofill ile yapiliyormus sanirim bu ama bulamadim pek bisey.
A sütunun 1. satirina yazdigim bir formülü otomatik olarak assaya sinirsiz sekilde nasil devam ettirebilirim?

 

[Korhan Ayhan]

Merhaba,

Formül olan hücreyi kopyalayıp alt hücrelere istediğiniz kadar yapıştırın.

Ya da eğer A sütunu doluysa formül olan hücrenin sağ alt köşesine mouse ile gelin. Mouse işaretçisi ince + olduğunda mousun sol tuşu ile + işareti üzerine çift tıklayın. Bu şekilde otomatik A sütunundaki veri kadar formülünüz alt satırlara dolacaktır.

 

[Lucky1905]

Merhaba,

Tesekkürler yaziniz icin ama makro ile yapsam daha iyi olacagini düsünüyorum.
Cünkü sütunun sinirsiz olmasini istiyorum, ynai ne kadar gelecegini bilmiyorum.
Diger türlü cekerek yaparsamda sayfanin o bölümlerni hep aktif etmis oluyorum.
Makro ile böyle bir kod yokmudur acabA?

 

[Korhan Ayhan]

Merhaba,

Örnek dosyanızı ekleyin. Onun üzerinden çözüm arayalım.

 

[Lucky1905]

Merhaba,

Dosyayi ekledim.
3. Sütunda c2 deki kodun devam etmesini istiyorum iste.
Bu arada tabella 2 de benim yaptiklarim. Söylemeyi unutmusum.

Tesekkürler

 

[Korhan Ayhan]

Merhaba,

Sayfanızdaki "Worksheet_Change" olayındaki kodu aşağıdaki gibi değiştirip deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
Dim lUsed As Long
If Target.Count > 1 Then GoTo exitHandler

On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitHandler

If rngDV Is Nothing Then GoTo exitHandler

If Intersect(Target, rngDV) Is Nothing Then
   'do nothing
   
If Target.Row = 3 Then
If Target.Rows.Count = ActiveSheet.Rows.Count Then Exit Sub
End If
If Target.Column = 3 Then
If Target.Columns.Count = ActiveSheet.Columns.Count Then Exit Sub
End If
   
Else
  Application.EnableEvents = False
  newVal = Target.Value
  Application.Undo
  oldVal = Target.Value
  Target.Value = newVal
  If Target.Column = 2 Then
    If oldVal = "" Then
      'do nothing
      Else
      If newVal = "" Then
      'do nothing
      Else
        lUsed = InStr(1, oldVal, newVal)
        If lUsed > 0 Then
            If Right(oldVal, Len(newVal)) = newVal Then
                Target.Value = Left(oldVal, Len(oldVal) - Len(newVal) - 2)
            Else
                Target.Value = Replace(oldVal, newVal & ", ", "")
            End If
        Else
            Target.Value = oldVal _
              & ", " & newVal
        End If
        
      End If
    End If
  End If

    Range("C2:C" & Rows.Count).ClearContents
    If Cells(Rows.Count, 2).End(3).Row > 1 Then
        With Range("C2:C" & Cells(Rows.Count, 2).End(3).Row)
            .Formula = "=MSUMME(B2,"","")"
        End With
    End If
End If

exitHandler:
  Application.EnableEvents = True
End Sub

 

[Lucky1905]

Tesekkürler mükemmel olmus.
Bu günlerin listesinide bu sekilde yapabilir miyiz peki?
Onuda ben belli bir yere kadar yapmistim.
Onuda sütunun sonuna kadar secmeli yapabilir miyiz?

 

[Korhan Ayhan]

Merhaba,

Günlerin listesi için veri doğrulama kullanmışsınız. Bu şekilde olan bir hücreyi kopyala-yapıştır ile en alt satıra kadar yapıştırın. Bence bunun için makroya gerek yok.

 

[Lucky1905]

Tamamdir tesekkürler