• DİKKAT

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

çoklu düşeyara formülünü makro ile yaptırmak

Function bHarf(Veri As String)
bHarf = UCase(Replace(Replace(Veri, "i", "İ"), "ı", "I"))
End Function

Bu kodu ilave ettiniz mi?

.
 
Kodu uyguladığınız dosya ekleyerek ne yapmak istediğinizi açıklayınız.

.
 
yrd

iyi günler ekdeki dosyanın gelir sayfasındaki kodda hata veriyor
2003 ofisinde
 

Ekli dosyalar

Ben herhangi bir hata almadım. Hangi işlemi yapınca hata mesajı alıyorsunuz.

.
 
gelir sayfasını açonca oradan alacak sayfasına geçince

If bHarf(Sa.Range("C" & c.Row)) = bHarf(.Offset(0, -1)) And _
bHarf(Sa.Range("D" & c.Row)) = bHarf(.Value) Then

bu kod sarı dolgu oluyor

ofis 2003 de oluyor
 
Eklendiğiniz tabloda mı hata alıyorsunuz yoksa orjinal dosyanızda mı.

Eklediğiniz tabloya göre ben hata almıyorum.

.
 
ömer bey özür diliyorum farklı dosya göndermişim yeni dosya gönderdim ekde bunda hata veriyor gelir sayfasını açınce ve veri yazınca
 

Ekli dosyalar

Kodu farklı bir olayın içine ilave etmişsiniz. Diğer kullandığınız kodları ne için kullanıyorsunuz. Detaylı açıklarsanız ona göre yeniden düzenlemeye çalışırım.

.
 
gelir sayfasındaki diğer kod büyük har küçük harf e dönüştürme işlemi yapıyor


listenin toplam satırı nı göster deyincede oluyor hata
 
Detaylı açıklamanızı rica etmiştim.

Büyük harf mi?, küçük harf mi?. Yada hangi sütun büyük, hagi sütun küçük.

.
 
BU BÖLÜM BÜYÜK HAR YAPIYOR 3- 6 SAYILAR 3. VE ALTINCI SATIRI YAPIYOR MU MANAYA GELİYOR
If Target.Column = 3 Or Target.Column = 6 Then
On Error Resume Next
Application.EnableEvents = False
Target.Value = UCase(Replace(Replace(Target.Value, "ı", "I"), "i", "İ"))
Application.EnableEvents = True
End If


BU BÖLÜMDE BAŞLIKLARI BÜYÜK SONRA KÜÇÜK SONRA SOYİSMİ BÜÜYK YAPIYOR 4. VE 5. SATIRLARI
If Target.Column = 4 Or Target.Column = 5 Then
Dim i As Integer, deg, deg2 As String
On Error Resume Next
Application.EnableEvents = False
Target.Value = WorksheetFunction.Proper(Target.Value)
deg = Split(Target.Value, " ")
For i = LBound(deg) To UBound(deg) - 1
deg2 = deg2 & " " & deg(i)
Next
Target.Value = deg2 & " " & UCase(Replace(Replace(deg(UBound(deg)), "ı", "I"), "i", "İ"))
Target.Value = Right(Target.Value, Len(Target.Value) - 1)
Application.EnableEvents = True
End If
 
ömer iyi çalışmalar açıklama yapmaya çalıştım anlata bildimmi bilmi yorum
1. bölümdeki kon şu şekilkde yapıyor yazılan veriyi "MUSTAFA KOZA" gibi
2. böümdeki "Mustafa KOZA" gibi yapıyor
 
İki sayfada da bulunan eski kodları silin.

Modul1:

Kod: 
Function bHarf(Veri As String)
    bHarf = UCase(Replace(Replace(Veri, "i", "İ"), "ı", "I"))
End Function
 
Function AdSoyad(Veri As String)
 
    Dim Ad As String, Soyad As String, i As Integer
    Dim Dizi() As String
 
    If Veri = "" Then Exit Function
 
    Dizi = Split(Veri, " ")
    If UBound(Dizi) > 0 Then
        For i = 0 To UBound(Dizi) - 1
            Ad = Trim(Ad & " " & Dizi(i))
        Next i
        Soyad = Dizi(UBound(Dizi))
    Else
        Ad = Veri
        Soyad = ""
    End If
    
    Ad = Application.WorksheetFunction.Proper(Ad)
    Soyad = UCase(Replace(Replace(Soyad, "i", "İ"), "ı", "I"))
    
    AdSoyad = Ad & " " & Soyad
    
End Function

"Alacak" Sayfasına;

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
 
    Application.EnableEvents = False
 
    With Target
        If .Column = 4 Or .Column = 5 Then
            .Value = AdSoyad(.Value)
        ElseIf .Column = 3 Or .Column = 6 Then
            .Value = bHarf(.Value)
        End If
    End With
    
    Application.EnableEvents = True
    
End Sub

"Gelir" Sayfasına;

Kod: 
Option Compare Text
 
Private Sub Worksheet_Change(ByVal Target As Range)
 
Dim c As Range, Sa As Worksheet, ilkadres As Variant
 
Set Sa = Sheets("ALACAK")
 
Application.EnableEvents = False
 
With Target
    If .Column = 3 Or .Column = 6 Then
        .Value = bHarf(.Value)
    ElseIf .Column = 4 Then
        .Offset(0, 1).ClearContents
        Set c = Sa.Range("B:B").Find(Target.Offset(0, -2), _
                                LookIn:=xlValues, LookAt:=xlWhole)
        If Not c Is Nothing Then
            ilkadres = c.Address
            Do
                If bHarf(Sa.Range("C" & c.Row)) = bHarf(.Offset(0, -1)) And _
                    bHarf(Sa.Range("D" & c.Row)) = bHarf(.Value) Then
                    .Offset(0, 1) = AdSoyad(Sa.Range("E" & c.Row))
                    .Value = AdSoyad(.Value)
                End If
                Set c = Sa.Range("B:B").FindNext(c)
            Loop While Not c Is Nothing And c.Address <> ilkadres
        End If
    End If
End With
 
Application.EnableEvents = True
End Sub

.
 
Set c = .Find(Target.Offset(0, -2), LookIn:=xlValues, LookAt:=xlWhole)

ömer bey gelir sayfasında adı soyadını yazınca bu kodda hata veriyor
birde alacak sayfasında adı soyadını sadece baş harflerini büyük yapıyor soy ismi tamamen büyük yapması lazım gelirde de aynı yani alacak ve gelirde 4. ve 5. satırları "Mustafa KOZA" gibi 3. 6. satırlar "MUSTAFA KOZA" gibi yapması lazım
 
Alacak ve gelir sayfalarında "alacak adı" sütununa veri yazıncada hata veriyor
 
#34 numaralı mesajdaki kodları düzenledim. Yeniden denermisiniz.
 
"Mustafa Koza" alacak ve gelir sayfasında 4. ve 5. satırlara yazınca bu şekilkde yapıyor soy isimide tamamen büüyk yapsa diğer seçenekleri deniyorum
 
ömer bey ilginiz için çok teşekkür ederim emeklerinize sağlık diğer işlemlerde hata vermedi ofis 2003 dede 2010 dada denim ancak dediğim gibi iism soy iism meseleisnide bir çözüverebilirmisiniz önceki kodda istediğim şekild eyapıyordu
 
#34 numaralı mesajdaki kodları tekrar düzenledim. Yeniden denermisiniz.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst