Toplama İşlemi

[yusuf1284]

(2) Tim (14) Personel
(1) Tim (10) Personel
(2) Asys (1) Haydi (14) Personel
Bu şekilde giden verilerim var bunları şu şekilde alt satırda nasıl toplarım
(3) Tim (2) Asys (1) Haydi (38) Personel
yapmak istediğim kaç çeşit tim olduğu ve toplam personel sayısı formül veya makro yardımlarınızı bekliyorum.

 

[Korhan Ayhan]

Bu verileriniz tek hücre içinde bulunuyorsa makro kullanmanız daha uygun olacaktır.

 

[yusuf1284]

Bu verileriniz tek hücre içinde bulunuyorsa makro kullanmanız daha uygun olacaktır.

Hocam dediğiniz gibi yapmaya çalıştım fakat
"(2) Asys (1) Haydi (5) Test (14) Personel" 3 çeşit tim olunca karıştı iş yardımcı olur musunuz

Sub SplitData()
Dim s1 As Worksheet
Dim rng1 As Range
Dim arr As Variant
Set s1 = ThisWorkbook.Sheets(test.Name)
s1.Range("B2:E100").ClearContents
lastRow = s1.Range("A2").End(xlDown).Row 'son boş satiri bulmak için
For Each rng1 In s1.Range("A" & "2" & ":" & "A" & lastRow)
If rng1.Value <> "" Then
    arr = Split(rng1.Value, " ")
    Count = UBound(arr) - LBound(arr) + 1
    For i = LBound(arr) To UBound(arr)
        If i Mod 2 = 0 Then
        ' Print the even number
       If arr(i + 1) <> "Personel" Then
      
            lastRow = s1.Cells(s1.Rows.Count, "D").End(3).Row + 1 'son boş satiri bulmak için
            aranan = arr(i + 1)
            Set alan = s1.Range("C" & "2" & ":" & "C" & lastRow).Find(What:=aranan, lookat:=xlWhole) 'tam eşleşme (LookAt:=xlWhole)
            If Not alan Is Nothing Then
                persay = arr(i)
                persay = Replace(persay, "(", "")
                persay = Replace(persay, ")", "")
                alan.Offset(0, 1).Value = alan.Offset(0, 1).Value + persay
                persay = 0
            Else
                s1.Cells(lastRow, "C").Value = arr(i + 1)
                persay = arr(i)
                persay = Replace(persay, "(", "")
                persay = Replace(persay, ")", "")
                s1.Cells(lastRow, "D").Value = persay
                persay = 0
            End If
            

        End If
        Else
            If arr(i) = "Personel" Then

                persay = arr(i - 1)
                persay = Replace(persay, "(", "")
                persay = Replace(persay, ")", "")
                s1.Range("B2").Value = s1.Range("B2").Value + persay
            End If
        End If
    Next i
  
    End If
 Erase arr
Next rng1
lastRow = s1.Cells(s1.Rows.Count, "C").End(3).Row + 1 'son boş satiri bulmak için
For Each rng1 In s1.Range("C" & "2" & ":" & "C" & lastRow)
   If rng1 <> "" Then
    rng1.Offset(0, 2).Value = "(" & rng1.Offset(0, 1).Value & ") " & rng1.Value
    If s1.Cells(1, "F").Value = "" Then
        s1.Cells(1, "F").Value = "(" & rng1.Offset(0, 1).Value & ") " & " " & rng1.Value & s1.Cells(1, "F").Value
    Else
        s1.Cells(1, "F").Value = " (" & rng1.Offset(0, 1).Value & ") " & " " & rng1.Value & s1.Cells(1, "F").Value
    End If
        
   End If
Next rng1
s1.Cells(1, "F").Value = s1.Cells(1, "F").Value & " " & "(" & s1.Cells(2, "B").Value & ") " & "Personel"
End Sub

 

[Korhan Ayhan]

Örnek dosya paylaşırsanız yardım almanız kolaylaşır.

 

[yusuf1284]

Şu şekilde hocam