• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Sayfaları tasnif edilmesi hk.

1903emre34@gmail.com

Altın Üye
Katılım
29 Mayıs 2016
Mesajlar
945
Excel Vers. ve Dili
Microsoft Excel 2013 Türkçe
Sayfalara gönder basıldığı zaman, Banka masraf ve komisyon giderleri sayfasında satıcı kur farkı giderleri gözükmekte olup, satıcı kur farkı giderleri sayfasında herhangi bir şey gözükmemektedir. Banka masraf sayfasında satıcı kur farkı giderleri gözükmemesi ve satıcı kur farkı giderleri sayfasında verilerin gelmesi için kodlarda nasıl değişiklik yapabiliriz.

https://s2.dosya.tc/server10/0zp0px/-sayfalara_tasnifle.xlsm.html
 
Sayfaları oluştururken Trim fonksiyonu ile fazla boşlukları siliyorsunuz. Bunun sonucunda kur farkı sayfasının adının sonunda boşluk olmuyor ama X sütunundaki değerlerde sonda bir boşluk var.

Analiz makrosunu aşağıdaki gibi değiştirin:

PHP:
Sub analiz()
Application.ScreenUpdating = False
On Error Resume Next
Sheets("SAYFA1").Range("x4:x65536").ClearContents
Set s1 = ThisWorkbook.Worksheets("SAYFA1")
For i = 4 To s1.Range("A65536").End(xlUp).Row
If Left(s1.Cells(i, 1), 2) = "88" Or Left(s1.Cells(i, 1), 2) = "89" Or Left(s1.Cells(i, 1), 2) = "81" Then
s1.Cells(i, "x") = Trim(Left(Trim(Left(s1.Cells(i, 1), 3)) & "-" & Trim(s1.Cells(i, 2)), 31))
End If
Next i
Application.ScreenUpdating = True
MsgBox "İşlem TAMAM.", vbInformation
End Sub

Çözümle ilgisi var mı bilmiyorum ama sayfalara gönder makrosunu aşağıdaki gibi değiştirmiştim, eğer analiz makrosu sonucunda hata ortadan kalktıysa bu makroyu değiştirmenize gerek yok:

PHP:
Sub sayfalara_gönder()
Application.ScreenUpdating = False
On Error Resume Next
say = 0
Set s1 = ThisWorkbook.Worksheets("SAYFA1")
For i = 4 To s1.Range("x65536").End(xlUp).Row
    If s1.Cells(i, "x") <> "" And s1.Cells(i, "y") = "" Then
        sonsatir = Sheets(s1.Cells(i, "x").Value).Range("A65536").End(xlUp).Row + 1
        For k = 1 To 23
            Sheets(s1.Cells(i, "x").Value).Cells(sonsatir, k) = s1.Cells(i, k)
        Next k
        s1.Cells(i, "y") = 1
        say = say + 1
    End If
Next i

Application.ScreenUpdating = True
If say >= 1 Then MsgBox say & " Adet veri Tasniflendi.", vbInformation
If say = 0 Then MsgBox " Tasiflenecek veri bulanamadı. (verilerin tasniflenmesi için Y sütununda ilgili satırda veri olmamalı.)", vbCritical

End Sub
 
Merhaba;
Özel msg uyarınıza istinaden (syn. YUSUF44'ün kod çözümünü denemedim ama) eki deneyin.
İyi çalışmalar.
 

Ekli dosyalar

Geri
Üst