Hücre birleştirme sorunu yardım lütfen

[merttbey]

Arkadaşlar cari hesaplarımı takip ettik isteğim ekte bi çalışma var.Yanlız döviz hareketlerini de takip etmem gerekiyor.Oluşturmuş olduğum dosyada kur bilgilerini düşeyara ile başka bi çalışma kitabından alıyorum ançak birleştirlmesi gereken hücrelerim oluyor buda diğer satırlara kur bilgisinin gelmesini engelliyor.Ekteki dosya üzerinde açıklamaları yaptım yardımcı olursanız sevinirim

 

[Korhan Ayhan]

Merhaba,

Hücreleri birleştirme işlemi makro ile otomatik hale getirilebilir. Fakat şöyle bir sorun ortaya çıkar. Diyelimki hücreleri birleştirdik ve siz "evrak no" sütununa göre verileri süzmek istediniz. İşte bu aşamada sorun yaşarsınız. Çünkü filtre uyguladığınızda sadece ilk satır verisini görüntüleyebileceksiniz.

Yine de birleştirmek istiyorum derseniz ona göre kod hazırlayabiliriz.

 

[merttbey]

korhan hocam herhangi bir süzme yapmıcam mevcut haliyle birleştirse bana çok büyük yardım etmiş olursun

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki kodu bir butona atayıp denermisiniz. A sütununda gerekli hücre birleştirmelerini elle yaptıktan sonra kodu çalıştırın.

Hatasız çalışması için iki dosya aynı klasörde olmalıdır.

Option Explicit
 
Sub HÜCRELERİ_BİRLEŞTİR()
    Dim Yol As String, X As Integer, Son As Integer, Say As Integer
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Range("M10:M65536").UnMerge
    Range("Q10:Q65536").UnMerge
    Son = Cells(65536, "C").End(3).Row
    Yol = ThisWorkbook.Path & "\"
    
    Range("M10:M" & Son) = "=IF(ISERROR(VLOOKUP(C[-12],'" & Yol & "[KUR.xls]Sayfa1'!C1:C3,2,FALSE)),"""",VLOOKUP(C[-12],'" & Yol & "[KUR.xls]Sayfa1'!C1:C3,2,FALSE))"
    Range("Q10:Q" & Son) = "=IF(ISERROR(VLOOKUP(C[-16],'" & Yol & "[KUR.xls]Sayfa1'!C1:C3,3,FALSE)),"""",VLOOKUP(C[-16],'" & Yol & "[KUR.xls]Sayfa1'!C1:C3,3,FALSE))"
    Range("N10:N" & Son) = "=IF(ISERROR(RC[-4]/LOOKUP(2,1/(R10C13:RC13<>""""),R10C13:RC13)),"""",ROUND(RC[-4]/LOOKUP(2,1/(R10C13:RC13<>""""),R10C13:RC13),2))"
    Range("O10:O" & Son) = "=IF(ISERROR(RC[-4]/LOOKUP(2,1/(R10C13:RC13<>""""),R10C13:RC13)),"""",ROUND(RC[-4]/LOOKUP(2,1/(R10C13:RC13<>""""),R10C13:RC13),2))"
    Range("P10:P" & Son) = "=IF(ISERROR(RC[-1]-RC[-2]),"""",RC[-1]-RC[-2])"
    Range("R10:R" & Son) = "=IF(ISERROR(RC[-8]/LOOKUP(2,1/(R10C17:RC17<>""""),R10C17:RC17)),"""",ROUND(RC[-8]/LOOKUP(2,1/(R10C17:RC17<>""""),R10C17:RC17),2))"
    Range("S10:S" & Son) = "=IF(ISERROR(RC[-8]/LOOKUP(2,1/(R10C17:RC17<>""""),R10C17:RC17)),"""",ROUND(RC[-8]/LOOKUP(2,1/(R10C17:RC17<>""""),R10C17:RC17),2))"
    Range("T10:T" & Son) = "=IF(ISERROR(RC[-1]-RC[-2]),"""",RC[-1]-RC[-2])"
    
    For X = 10 To Son
        Say = Cells(X, "A").MergeArea.Cells.Count
        If Say > 1 Then
            Application.DisplayAlerts = False
            Range("M" & X, "M" & X + Say - 1).Merge
            Range("Q" & X, "Q" & X + Say - 1).Merge
        End If
        X = X + Say - 1
    Next
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[red_lion_72]

Selam,
Cari KArt-m10 hücresine şu formülü yazıp aşağıya kadar kopyala lütfen.

=EĞER(A10="";M9;DÜŞEYARA(A10;[KUR.xls]Sayfa1!$A$2:$C$366;2;0))

KOlay gelsin.

 

[merttbey]

Korhan hocam kodu yazdığımda ilk birleştirme için işlem yaıyor ama sonraki birleştirmelerde işlem yapmıyor.birde red lion 72 arkadaş bi formul yollamış bu formul işe yarıyor bu formulle beraber sizin birleştirme problemi çözülse çok süper olacak

 

[Korhan Ayhan]

Merhaba,

Ben eklediğiniz ilk dosyada deneme yapıyorum şuan. Makroyu defalarca çalıştırdım ve bir sorun çıkmadı. Bu durumda sizin uyguladığınız dosyada farklı bir durum var. Dosyanızı ekleyin kontrol edelim.

 

[merttbey]

Korhan hocam dosya ekte makroyu ctrl+shift+b tuşuna atadım
KORHAN HOCAM SİZİN DOSYANIZI BURAYA EKLESENİZ OLURMU

 

[Korhan Ayhan]

Merhaba,

Eklediğiniz dosyada bir problem görünmüyor. Defalarca tıkladım makro çalışıyor.

 

[merttbey]

Korhan hocam seni çok yordum biliyorum ama makroyu çalıştıramıyorum. Ilk birleştirmeyi yapıyor 2. Veya 3. Denediğimde işleminiz tamamlanmıştır diyor ama birleşme olmuyor veya ben beceremiyorum

 

[Korhan Ayhan]

Merhaba,

Son eklediğiniz dosyayı açıyorum. M10:M14 hücreleri birleşmiş durumda. Makroyu çalıştırıyorum. Zaten birleşmiş olduğu için herhangi bir işlem yapmıyor.

Siz denemek için A sütununda 15. satıra başka bir tarih girin ve birkaç hücreyi birleştirin. C sütununada gerekli bilgileri girin. Daha sonra makroyu çalıştırın. Sanıyorum siz C sütununa açıklama yazmadan makroyu çalıştırıyorsunuz. Kodun düzgün çalışması için C sütununda ilgili satırların tamamında veri olması gerekiyor.

 

[merttbey]

teşekkür

Korhan hocam usta farkı işte aynen ben herhangi bişey yazmadan deniyordum çok teşekkür ederim elinize sağlık çok yardımcı oldunuz çok sağ olun

 

[merttbey]

korhan hocam benim cari hesapta düşündümde biraz daha değişik kullansam daha iyi olcak gibi geldi bana senin kodu şu şekilde değiştirdim ancak C stünundaki hücrelere yazı yazmadan makro çalışmıyor tek harf bile yazsam çalışıyor bunu nasıl düzeltiriz Option Explicit

Sub HÜCRELERİ_BİRLEŞTİR()
Dim Yol As String, X As Integer, Son As Integer, Say As Integer

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Range("B10:B65536").UnMerge
Range("J10:J65536").UnMerge
Range("K10:K65536").UnMerge
Range("L10:L65536").UnMerge
Range("M10:M65536").UnMerge
Range("N10:N65536").UnMerge
Range("O10:O65536").UnMerge
Range("P1065536").UnMerge
Range("Q10:Q65536").UnMerge
Range("R10:R65536").UnMerge
Range("S10:S65536").UnMerge
Range("T10:T65536").UnMerge

Son = Cells(65536, "C").End(3).Row
Yol = ThisWorkbook.Path & "\"

For X = 10 To Son
Say = Cells(X, "A").MergeArea.Cells.Count
If Say > 1 Then
Application.DisplayAlerts = False
Range("B" & X, "B" & X + Say - 1).Merge
Range("J" & X, "J" & X + Say - 1).Merge
Range("K" & X, "K" & X + Say - 1).Merge
Range("L" & X, "L" & X + Say - 1).Merge
Range("M" & X, "M" & X + Say - 1).Merge
Range("N" & X, "N" & X + Say - 1).Merge
Range("O" & X, "O" & X + Say - 1).Merge
Range("P" & X, "P" & X + Say - 1).Merge
Range("Q" & X, "Q" & X + Say - 1).Merge
Range("R" & X, "R" & X + Say - 1).Merge
Range("S" & X, "S" & X + Say - 1).Merge
Range("T" & X, "T" & X + Say - 1).Merge

End If
X = X + Say - 1
Next

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

 

[Korhan Ayhan]

Merhaba,

Örnek dosyanıza göre en uygun sütun "C" sütunu olduğu için orayı tanımlamıştım. Dilerseniz "Son" değişkenine manuel bir değerde verebilirsiniz.

Verilerinizin çokluğuna göre;

Son=100
Son=1000

Şeklinde tanımlamalar yapabilirsiniz.