• DİKKAT

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

İban no düzeltilmesi, Adı ve soyad ayrı ayrı, üst bilgideki sayfanın en üstündeki yaz

I

istanbulcahan

Katılım
11 Ocak 2008
Mesajlar
1,395
Excel Vers. ve Dili
Office 365 (Türkçe)
Aşağıdakileri nasıl yapabilirim. Örnek dosyada ektedir.

BURHAN FELEK SPOR SALONU 01 -31 KASIM 2010
İBAN NO NET TUTAR
1 TR 2456 2345 3456 4456 4459 5048 45.69 MehmetÖztaş

1) DÜZELTİLECEK
İBAN NO NET TUTAR ADI
a) TR245623453456445644595048 45.69 Mehmet Öztaş



b) İBAN BÖLÜMÜNDEKİ ARALIKLAR CTRL+F tuşuna basarak ara bölümündeki space bir boşluk makro ile yapılmaıs işlemi yapılarak



2)sonra yapılacak
BURHAN FELEK SPOR SALONU 01 -31 KASIM 2010
başlığı;
a) OOTOMATİKMAN üst bilgide ortalıyarak gözükecek.
b) yazıcı ayarlarıda otomatikman yapılacak.
 

Ekli dosyalar

Merhaba,

Aşağıdaki kodları deneyiniz, belki olmuştur :)

Kod: 
Sub Duzelt()
    Dim i As Long
    Dim j As Integer
    
    For i = 3 To [B65536].End(3).Row
        Cells(i, "b") = Replace(Cells(i, "b"), " ", "")
        Cells(i, "d") = CDbl(Replace(Cells(i, "d"), ".", ","))
        For j = 1 To Len(Cells(i, "e"))
            If Mid(StrReverse(Cells(i, "e")), j, 1) Like "[A-Z]" Or _
                Mid(StrReverse(Cells(i, "e")), j, 1) = "Ç" Or _
                Mid(StrReverse(Cells(i, "e")), j, 1) = "İ" Or _
                Mid(StrReverse(Cells(i, "e")), j, 1) = "Ö" Or _
                Mid(StrReverse(Cells(i, "e")), j, 1) = "Ş" Then
                Cells(i, "f") = Right(Cells(i, "E"), 5)
                Cells(i, "e") = Replace(Cells(i, "e"), Cells(i, "f"), "")
                Exit For
            End If
        Next j
    Next i

    With Sheets("Sayfa1").PageSetup
        .LeftHeader = ""
        .CenterHeader = Sheets("Sayfa1").[B1]
        .RightHeader = Sheets("Sayfa1").[D1]
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
    End With
End Sub
 
istanbulcahan' Alıntı:
Aşağıdakileri nasıl yapabilirim. Örnek dosyada ektedir.

BURHAN FELEK SPOR SALONU 01 -31 KASIM 2010
İBAN NO NET TUTAR
1 TR 2456 2345 3456 4456 4459 5048 45.69 MehmetÖztaş

1) DÜZELTİLECEK
İBAN NO NET TUTAR ADI
a) TR245623453456445644595048 45.69 Mehmet Öztaş



b) İBAN BÖLÜMÜNDEKİ ARALIKLAR CTRL+F tuşuna basarak ara bölümündeki space bir boşluk makro ile yapılmaıs işlemi yapılarak



2)sonra yapılacak
BURHAN FELEK SPOR SALONU 01 -31 KASIM 2010
başlığı;
a) OOTOMATİKMAN üst bilgide ortalıyarak gözükecek.
b) yazıcı ayarlarıda otomatikman yapılacak.
Genişletmek için tıkla ...

dosyanıza baktım böyle anlamak zor siz dosyanıza iki ayrı sayfa ekleyin
1-mevcut durum
2-olmasını istediğiniz durum.
 
Merhaba,

Pekiii olmayan nedir bu dosyada?
 

Ekli dosyalar

Hocam bide eski haline nasıl getircez onu yaparmıısnız :D
 
Merhaba,

İlk gönderdiğiniz dosyada B ve C sütunu birleştirilmişti, oysa şimdiki dosyada birleştirmeyi kaldırmışsınız.

Dolayısıyla kodlarda kullanılan sütunlar doğal olarak kaymış.

Tutarı düzeltmek için (noktayı virgül yapmak için) D sütununda işlem yapıyordu şimdi ise C sütununda yapması gerek.

İsimleri düzeltirken E sütununda olduğunu varsayarken şimdi D sütununa gelmiş.

Ayrıca IBAN numaralarının arasında boşluk olduğunu söylüyordunuz oysa gönderdiğiniz dosyada bu boşluk yok, hata da bunun için veriyordu.

Son gönderdiğiniz dosyaya göre kodları değiştirdim ve hata kontrolünü ekledim.

Lütfen gönderdiğiniz dosya üzerinde çalıştığınız örnek dosya ile aynı olsun. İnsanı töhmet altında bırakıyorsunuz.

Kod: 
Sub Duzelt()
    [B][COLOR=red]On Error Resume Next
[/COLOR][/B]    Dim i As Long
    Dim j As Integer
    
    For i = 3 To [B65536].End(3).Row
        Cells(i, "b") = Replace(Cells(i, "b"), " ", "")
        Cells(i, "C") = CDbl(Replace(Cells(i, "d"), ".", ","))
        For j = 1 To Len(Cells(i, "D"))
            If Mid(StrReverse(Cells(i, "D")), j, 1) Like "[A-Z]" Or _
                Mid(StrReverse(Cells(i, "D")), j, 1) = "Ç" Or _
                Mid(StrReverse(Cells(i, "D")), j, 1) = "İ" Or _
                Mid(StrReverse(Cells(i, "D")), j, 1) = "Ö" Or _
                Mid(StrReverse(Cells(i, "D")), j, 1) = "Ş" Then
                Cells(i, "E") = Right(Cells(i, "D"), j)
                Cells(i, "D") = Replace(Cells(i, "D"), Cells(i, "E"), "")
                Exit For
            End If
        Next j
    Next i
    With Sheets("Sayfa1").PageSetup
        .LeftHeader = ""
        .CenterHeader = Sheets("Sayfa1").[B1]
        .RightHeader = Sheets("Sayfa1").[D1]
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
    End With
End Sub
 
Evet üstadım. İşlemi yaptım ve Aceleden çıktım maça gittim farkında olmadım, yoğunluktan kusura bakma. Emeğine sağlık.
 
Necdet Yeşertener' Alıntı:
Merhaba,

İlk gönderdiğiniz dosyada B ve C sütunu birleştirilmişti, oysa şimdiki dosyada birleştirmeyi kaldırmışsınız.

Dolayısıyla kodlarda kullanılan sütunlar doğal olarak kaymış.

Tutarı düzeltmek için (noktayı virgül yapmak için) D sütununda işlem yapıyordu şimdi ise C sütununda yapması gerek.

İsimleri düzeltirken E sütununda olduğunu varsayarken şimdi D sütununa gelmiş.

Ayrıca IBAN numaralarının arasında boşluk olduğunu söylüyordunuz oysa gönderdiğiniz dosyada bu boşluk yok, hata da bunun için veriyordu.

Son gönderdiğiniz dosyaya göre kodları değiştirdim ve hata kontrolünü ekledim.

Lütfen gönderdiğiniz dosya üzerinde çalıştığınız örnek dosya ile aynı olsun. İnsanı töhmet altında bırakıyorsunuz.

Kod: 
Sub Duzelt()
    [B][COLOR=red]On Error Resume Next
[/COLOR][/B]    Dim i As Long
    Dim j As Integer
    
    For i = 3 To [B65536].End(3).Row
        Cells(i, "b") = Replace(Cells(i, "b"), " ", "")
        Cells(i, "C") = CDbl(Replace(Cells(i, "d"), ".", ","))
        For j = 1 To Len(Cells(i, "D"))
            If Mid(StrReverse(Cells(i, "D")), j, 1) Like "[A-Z]" Or _
                Mid(StrReverse(Cells(i, "D")), j, 1) = "Ç" Or _
                Mid(StrReverse(Cells(i, "D")), j, 1) = "İ" Or _
                Mid(StrReverse(Cells(i, "D")), j, 1) = "Ö" Or _
                Mid(StrReverse(Cells(i, "D")), j, 1) = "Ş" Then
                Cells(i, "E") = Right(Cells(i, "D"), j)
                Cells(i, "D") = Replace(Cells(i, "D"), Cells(i, "E"), "")
                Exit For
            End If
        Next j
    Next i
    With Sheets("Sayfa1").PageSetup
        .LeftHeader = ""
        .CenterHeader = Sheets("Sayfa1").[B1]
        .RightHeader = Sheets("Sayfa1").[D1]
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
    End With
End Sub
Genişletmek için tıkla ...
Üstadım. Makroyu aynen uyguladım. Diğeri olmuştu bu sefer adını ve soyadını birleşik düzeltiyor. Soyadının son harfini diğer hücrede gösteriyor.
 

Ekli dosyalar

Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst