Hücreleri Duruma Göre Birleştirme

[ErdemBakir24]

Merhabalar,

http://s3.dosya.tc/server10/nfbjox/products.xlsx.html

Durum biraz karışık olduğundan ekteki örnek dosyanın "Örnek" adlı sayfasında uzun uzun açıkladım. Yardımcı olurmusunuz lütfen.

Teşekkürler.

 

[PLİNT]

Merhaba
Ek dosyayı deneyiniz
Eğer "B" hücresi aynı olsada birleşmesi gerekse; aşağıdaki kırmızı bölümü silersiniz.

Private Sub CommandButton1_Click()
For a = 2 To Cells(Rows.Count, 1).End(3).Row
For b = Cells(Rows.Count, 1).End(3).Row To a + 1 Step -1
If Trim(Cells(a, "A")) & Trim(Cells(a, "F")) = _
Trim(Cells(b, "A")) & Trim(Cell[COLOR="Red"]s(b[/COLOR], "F")) Then
Cells(a, "B") = Trim(Cells(a, "B"))
[COLOR="Red"]Set r = Range("B" & a).Find(Cells(b, "B").Value, , xlValues, xlPart)
If r Is Nothing Then[/COLOR]
If Right(Cells(a, "B"), 1) = "-" Then _
Cells(a, "B") = Trim(Left(Cells(a, "B"), Len(Cells(a, "B")) - 1))
Cells(a, "B") = Trim(Cells(a, "B")) & " - " & Trim(Cells(b, "B"))
[COLOR="Red"]Set r = Nothing
End If[/COLOR]
Cells(b, "A").EntireRow.Delete
End If
Next
If Cells(Rows.Count, 1).End(3).Row = a Then Exit For
Next
End Sub

 

[ErdemBakir24]

merhaba PLİNT,

verdiğiniz uğraş için teşekkür ederim. Ancak yaptığınız örnek dosya sadece A sütunu aynı olan ürünlerin B sütunlarını birleştiriyor. 1 no'lu mesajdaki örnek dosyada F sütunun öncelikli olduğunu belirtmiştim.

Teşekkür ederim.

 

[PLİNT]

Merhaba
Yukarıdaki kodda;

Trim(Cells(b, "A")) & Trim(Cel[COLOR="Red"]ls(b[/COLOR], "F")) Then

"a" yerine "b" olmalıydı hata yapmışız
Birkaç ekleme daha yapmaya çalıştığım ek dosyayı deneyin.
http://s3.dosya.tc/server10/cmptjd/products.zip.html

[SIZE="2"]Private Sub CommandButton1_Click()
For a = 2 To Cells(Rows.Count, 1).End(3).Row
For b = Cells(Rows.Count, 1).End(3).Row To a + 1 Step -1

If Trim(Cells(a, "A")) & Trim(Cells(a, "F")) = _
Trim(Cells(b, "A")) & Trim(Cells(b, "F")) Then

Cells(a, "B") = Trim(Cells(a, "B"))
Set r = Range("B" & a).Find(Trim(Cells(b, "B").Value), , xlValues, xlPart)
If r Is Nothing Then
If Right(Trim(Cells(a, "B")), 1) = "-" Then _
Cells(a, "B") = Trim(Left(Trim(Cells(a, "B")), Len(Trim(Cells(a, "B"))) - 1))
Cells(a, "B") = Trim(Cells(a, "B")) & " - " & Trim(Cells(b, "B"))
Set r = Nothing
End If
Cells(b, "A").Select
Cells(b, "A").EntireRow.Delete
End If
Next
If Cells(Rows.Count, 1).End(3).Row = a Then Exit For
Next
End Sub [/SIZE]

 

[ErdemBakir24]

Tekrar merhaba PLİNT,

Yardım ettiğin için çok teşekkür ederim.

Beni nasıl bir işten kurtardığının farkındasın Minnettarım.