Birden fazla değer geitrme

[Bakigemlik]

Merhaba,

Ek dosya hakkında desteğinizi rica ederim,

Saygılarımla,

 

[YUSUF44]

Formülle nasıl yapılır bilmiyorum maalesef ancak makroyla aşağıdaki çözümü ürettim. Bir modüle kopyalayıp deneyiniz.

Veri yapınıza bağlı olarak birden fazla döngü kullanıldığından veriler örnek dosyadaki gibi çok olduğunda makronun çalışması uzun sürmektedir.

Sub FID()
son = Cells(Rows.Count, 1).End(3).Row
For i = 2 To WorksheetFunction.Max(2, son)
    If WorksheetFunction.CountIf(Range("AB2:A" & i), Cells(i, 1)) <= 1 Then
        Cells(i, 3) = Cells(i, 2)
    Else
        For j = 2 To WorksheetFunction.Max(2, i)
            If Cells(j, 1) = Cells(i, 1) Then
            sat = Cells(j, 2).End(xlToRight).Column + 1
            Cells(j, sat) = Cells(i, 2)
            j = i
            End If
        Next
    End If
Next
End Sub

 

[Emir Hüseyin Çoban]

. . .

14bin satır veri olunca işlem süresi uzun oluyor.

Sub kod()
    Application.ScreenUpdating = False
    Range("C1:Z65536").ClearContents
    son = Cells(Rows.Count, "A").End(3).Row
    For i = 2 To Cells(Rows.Count, "A").End(3).Row
        süt = 3
        If WorksheetFunction.CountIf(Range("A2:A" & i), Cells(i, "A")) = 1 Then
            Set ara = Range("A1:A" & son).Find(Cells(i, "A"), , xlValues, xlWhole)
            If Not ara Is Nothing Then
                adres = ara.Address
                Do
                    Cells(i, süt) = Cells(ara.Row, "B")
                    Set ara = Range("A1:A" & son).FindNext(ara)
                    süt = süt + 1
                    Loop While Not ara Is Nothing And ara.Address <> adres
                End If
            End If
        Next i
        Application.ScreenUpdating = True
        MsgBox " B i t t i "
End Sub

. . .

 

[Bakigemlik]

Hüseyin Hocam desteğiniz ve çözümünüz için çok teşekkürler,

Sizden ayrıca bir konuda destek rica edeceğim, aşağıdaki sorunum için uzun süredir cevap alamadım destek olmanız mümkün müdür ?

http://www.excel.web.tr/f48/ay-sonu-prim-hesaplama-t142440/sayfa2.html#post776169

Saygılarımla,