Hesap planındaki açıklamaları diğer sayfalardaki kodlarla eşleştirmek

[1903emre34@gmail.com]

Merhaba,

Yandaki "A" sütundaki, noktasız ve harfsiz olanların (Kasa,Alınan Çekler vs) Sayfa2 deki tek düzen hesap planında kodlara göre bakıp , Sayfa1'deki kodlarını yazılmasını istiyorum, manuel olarak bir örnek olarak sarı ile boyanmıştır. nasıl kod oluşturabiliriz?

http://s9.dosya.tc/server2/ako0i1/hesap_kodlari.zip.html

 

[Asri]

Deneyiniz.

Her iki sayfa da A1 den başlamalı.

Sayfa2 de sayı ile başlayan satırlar alt hesaplar
Sayı ile başlamayan satırlar ana başlıklar olarak kabul edilir.

http://dosya.co/hq10aojdn0mt/hesap_kodları.xlsm.html

Dim liste1(10000, 3) As String
Dim liste2(10000, 3) As String
Dim varlikliste(1000) As String

Dim sayfa2sonsatir, varliksay As Long

Sub menu()
   Call liste_yukle
   Call karsilastir
End Sub

Sub liste_yukle()
   Sheets("Sayfa2").Select
   varliklar = ""
   sayfa2sonsatir = Cells(Rows.Count, "A").End(3).Row
   varliksay = 0
   For i = 1 To sayfa2sonsatir
     veri = turkce_harf_olmasin(Cells(i, 1).Value)
     
     If sadecesayimi(Left(veri, 1)) Then
        sayiveri = Trim(Mid(veri, 1, InStr(veri, ".") - 1))
        sayisizveri = Trim(Mid(veri, InStr(veri, ".") + 1, Len(veri)))
        liste2(i, 1) = varliklar
        liste2(i, 2) = sayisizveri
        liste2(i, 3) = sayiveri
     Else
        varliklar = Trim(veri)
        varliksay = varliksay + 1
        varlikliste(varliksay) = Trim(veri)
     End If
   Next i
End Sub

Sub karsilastir()
   Sheets("Sayfa1").Select
   sonsatir = Cells(Rows.Count, "A").End(3).Row
   varliklar = ""
   For i = 1 To sonsatir
     veri = Cells(i, 1).Value
     veriozel = turkce_harf_olmasin(Trim(veri))
     If Left(veriozel, 1) = "." Then GoTo son
     For k = 1 To varliksay
        If veriozel = varlikliste(k) Then
           varliklar = veriozel
           Exit For
        End If
     Next k
     
     If veri = "" Then GoTo son
     For j = 1 To sayfa2sonsatir
       If liste2(j, 1) = varliklar And liste2(j, 2) = veriozel Then
        Cells(i, 1).Value = veri & " " & liste2(j, 3)
       End If
     Next j
son:
   Next i
End Sub

Public Function turkce_harf_olmasin(cumle)
gecici = ""
For i = 1 To Len(cumle)
          h = Mid(cumle, i, 1)
          Select Case h
            Case "ğ": gecici = gecici + "g"
            Case "Ğ": gecici = gecici + "G"
            Case "ü": gecici = gecici + "u"
            Case "Ü": gecici = gecici + "U"
            Case "ş": gecici = gecici + "s"
            Case "Ş": gecici = gecici + "S"
            Case "ç": gecici = gecici + "c"
            Case "Ç": gecici = gecici + "C"
            Case "ö": gecici = gecici + "o"
            Case "Ö": gecici = gecici + "O"
            Case "İ": gecici = gecici + "I"
            Case "ı": gecici = gecici + "i"
            Case Else: gecici = gecici + h
            End Select
Next i
turkce_harf_olmasin = gecici
End Function

Function sadecesayimi(sadecesayistr)
  listesayi = "0123456789"
  For k = 1 To Len(sadecesayistr)
    harf = Mid(sadecesayistr, k, 1)
    If InStr(listesayi, harf) = 0 Then
       sadecesayimi = False
       Exit Function
    End If
  Next k
  sadecesayimi = True
End Function

 

[1903emre34@gmail.com]

ilginiz için teşekkürler, dosyayı güncelledim

 

[Asri]

ilginiz için teşekkürler, dosyayı güncelledim

Anladığım kadarı ile soru değişmiş.
Tekrar değişme ihtimali var mı : )

 

[1903emre34@gmail.com]

Kusura bakmayın yeterli açıklama yapmadım değişme ihtimali yok

 

[Asri]

Kod güncellendi.

 

[assenucler]

Çok güzel, muhasebe ile uğraşanların işine yarayabilir. Emek ve paylaşımınız için teşekkürler Sayın asri...

 

[1903emre34@gmail.com]

Çalıştırdım, ama hata verdi,

 

[Asri]

Çalıştırdım, ama hata verdi,

Sorun göremedim. Dosya olarak da eklendi.

 

[1903emre34@gmail.com]

Asri bey, çok teşekkürler