Birleştirilmiş hücrelerin makro ile toplanması

[izcik]

Günaydın uzmanlarım. Sayfa 1 deki miktarları,
Sayfa 2 de olduğu gibi hem birleştirip hem de toplayacak kodu yazabilir misiniz.

Çözüm aynı sayfada da olabilir, (Mesela 1. sayfada E ve F sütunlarına dökebilir.)

Ya da 2. sayfada olabilir.

Fakat ikisinin de kodunu verebilirseniz çok daha iyi olur. İkisini de öğrenmiş ve denemiş olurum.


Teşekkür ederim kolay gelsin herkese.

 

[uzmanamele]

merhaba

syn izcik, aşağıdaki linkte 7. mesajı okuyunuz!

tık tık tık...

 

[İhsan Tank]

formülle daha kolay olmaz mı sizce_?

 

[izcik]

merhaba

syn izcik, aşağıdaki linkte 7. mesajı okuyunuz!

tık tık tık...

Okudum değerli uzmanamele.

 

[izcik]

Sorunumla ilgili öneriniz varmı değerli uzmanım

 

[izcik]

Değerli uzmanlarım sorunumu çözecek gerekli kodu merakla bekliyorum

 

[izcik]

Uzmanamele uzmanım mesajımı farketmediğinizi düşündüğümden aynı mesajın tekrarını yazmak durumunda kaldım, rica etsem gerekli kodları verebilir misiniz?

 

[Orion1]

Dosyanız ektedir.

Sub toplamlar()
Dim i As Long, sat As Long, son As Long
Sheets("Sayfa2 BÖYLE OLMALI").Select
Application.ScreenUpdating = False
Range("A2:B65536").ClearContents
sat = 2
With Sheets("Sayfa1 BU SAYFA")
    son = .Cells(65536, "A").End(xlUp).Row
    For i = 2 To son
        If WorksheetFunction.CountIf(.Range("A2:A" & i) _
        , .Cells(i, "A").Value) = 1 Then
            Cells(sat, "A").Value = .Cells(i, "A").Value
            Cells(sat, "B").Value = WorksheetFunction.SumIf(.Range("A" & _
            i & ":A" & son), .Cells(i, "A").Value, .Range("B" & i & ":B" & son))
            sat = sat + 1
        End If
    Next i
End With
Application.ScreenUpdating = True
MsgBox "İşlem Tamamdır." & vbLf & vbLf & _
"evrengizlenqhotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub

 

[izcik]

Evren Gizlen uzmanım teşekkür ederim. Stresten patlayacaktım.

Fakat hücreler birleşmiş haliyle kalmalı. Çünkü yanındaki sütunlarda başka bilgiler mevcut.

Size zahmet olacak ama.. Tıpkı örnekteki gibi yapabilir misiniz?

 

[Orion1]

Evren Gizlen uzmanım teşekkür ederim. Stresten patlayacaktım.

Fakat hücreler birleşmiş haliyle kalmalı. Çünkü yanındaki sütunlarda başka bilgiler mevcut.

Size zahmet olacak ama.. Tıpkı örnekteki gibi yapabilir misiniz?

En illet kaptığım şey şu hücre birleştirmeleri,biçimlendirmeler falan.Bunlar VBA'ya ters geliyor.Bu işlere ben girmek istemiyorum.Bu yüzden burdan sonrası için ben yokum.

 

[izcik]

Yani aynı kodlu ürünler birleşecek (exceldeki birleştir ve ortala düğmesinin yaptığı gibi)

Ve bu ürünlere ait miktarlar toplanıp, aynı büyüklükte birleşmiş olan hücrenin içine aktarılacak

 

[izcik]

Canınız sağolsun.

Teşekkürler tekrar ilgilendiğiniz için Evren Uzmanım.

 

[Orion1]

Canınız sağolsun.

Teşekkürler tekrar ilgilendiğiniz için Evren Uzmanım.

Rica ederim.
İyi çalışmalar.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz. Sayfa isimlerinizi koddaki isimlere göre düzenlemeyi unutmayın.

Option Explicit
 
Sub VERİLERİ_DÜZENLE_AKTAR()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim SATIR As Long, X As Long, SAY As Integer, TOPLAM As Double
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
    
    S2.Range("A2:B65536").Clear
    SATIR = 2
    S2.Columns("A:B").HorizontalAlignment = xlCenter
    For X = 2 To S1.Range("A65536").End(3).Row
        SAY = WorksheetFunction.CountIf(S1.Range("A:A"), S1.Cells(X, 1))
        TOPLAM = WorksheetFunction.SumIf(S1.Range("A:A"), S1.Cells(X, 1), S1.Range("B:B"))
        
        If WorksheetFunction.CountIf(S2.Range("A:A"), S1.Cells(X, 1)) = 0 Then
            If SAY > 1 Then
                With S2.Range("A" & SATIR & ":A" & SATIR + SAY - 1)
                    .Merge
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlCenter
                    .Value = S1.Cells(X, 1)
                End With
                With S2.Range("B" & SATIR & ":B" & SATIR + SAY - 1)
                    .Merge
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlCenter
                    .Value = TOPLAM
                End With
            Else
                S2.Cells(SATIR, 1) = S1.Cells(X, 1)
                S2.Cells(SATIR, 2) = TOPLAM
            End If
            
            SATIR = SATIR + SAY
        End If
    Next
    S2.Select
    
    Set S1 = Nothing
    Set S2 = Nothing
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[izcik]

Değerli Uzmanım Korhan Ayhan. Elinize emeğinize sağlık. Tam istediğim gibi. Saygılar.

 

[izcik]

Selam arkadaşlar ve uzmanlarım. Örnekte açıkladığım gibi daha öncekinin tam tersi işi yapacak kod lazım.

Yani birleştirilmiş hücreleri normal hale getirecek.

 

[Necdet]

Merhaba,

Aşağıdaki kodları dener misiniz?

Sub UnMerge()
Dim i As Long
Dim Deger As String
For i = 2 To [A65536].End(3).Row + 1
    If Range("A" & i).MergeArea.Count > 1 Then
        Cells(i, "A").UnMerge
        Deger = Cells(i, "A")
    Else
        Cells(i, "A") = Deger
    End If
Next i
End Sub

 

[izcik]

Teşekürler Necdet Yeşertener uzmanım. Bu değişikliği -eğer zor değilse- ikinci sayfada oluşacak şekilde yapabilir misiniz acaba?

Yani düğmeye basınca istenen sonuç ikinci sayfada oluşsun.

Saygılar

 

[Necdet]

Merhaba,

Sub UnMerge()
Dim i       As Long
Dim Deger   As String
[COLOR=red]Dim s1 As Worksheet
Dim s2 As Worksheet[/COLOR]
[COLOR=red]Set s1 = Sheets("Sayfa1 BU SAYFA")
Set s2 = Sheets("Sayfa2 BÖYLE OLMALI")[/COLOR]
[COLOR=red]s1.Range("A:A").Copy s2.Range("A1")
s2.Select[/COLOR]
For i = 2 To [A65536].End(3).Row + 1
    If Range("A" & i).MergeArea.Count > 1 Then
        Cells(i, "A").UnMerge
        Deger = Cells(i, "A")
    Else
        Cells(i, "A") = Deger
    End If
Next i
End Sub

 

[izcik]

Elinize fikrinize sağlık Necdet Yeşertener uzmanım.

Yalnız bir hatayı farkettim. ÜRÜN 3 yazan hücre , bu kodda da (mesaj 19) bir öncekinde de (mesaj 17) çıkmıyor.

ÜRÜN KODU
ÜRÜN 1
ÜRÜN 1
ÜRÜN 1
ÜRÜN 1
ÜRÜN 2
ÜRÜN 2
ÜRÜN 2
ÜRÜN 2
ÜRÜN 2
ÜRÜN 3
ÜRÜN 4
ÜRÜN 4
ÜRÜN 4
ÜRÜN 5
ÜRÜN 5


böyle olmalı

.........
Oysa ÜRÜN 3


ÜRÜN 2 nin içine dahil oluyor.