Soru KIRP // PARÇAAL Fonksiyonu

Ukde · 17 Eylül 2021

Örnek dosyada aşağıdaki işlemler konusunda lütfen yardımcı olabilir misiniz?

https://dosyam.org/2EUu/FRT1.xlsx

Ham veri yapıştırıldığında H sütunu açsın ve H sütununa uyguladığım formülü yapsın.
EĞER İşlem açıklamasında Komisyon varsa ilgili sütunun I sütununa kadar olan verisini alta kopyalasın
İşlem açıklamasındaki komisyonu H sütununa yazsın ve İşlem açıklamasını belirttiğim şekilde yazsın.
eğer işlem açıklamasına yazdığımı yazdığım şekilde oluşturamıyorsa sadece POS KOMİSYONU yazsa da olur
H sütununu hesaplatmak için yukarıdaki formülü kullandım ama sonuç alamadım.

=-1*EĞERHATA(KIRP(EĞER(KIRP(PARÇAAL(J2;MBUL("Komisyon :";J2;2))="Komisyon :";PARÇAAL(J2:MBUL("Komisyon :";J2)+2;100),""));"0,00")

ÖmerFaruk · 17 Eylül 2021

Aşağıdaki kodları bir Module içine ekleyip çalıştırabilirsiniz.
İşlemmiş Veri tablonuzun formatını da birazcık düzenledim.
İnceleyin lütfen.

C++:

Sub Komisyonlar()
Dim Sh1 As Worksheet, Sh2 As Worksheet
Dim Kom1 As Integer, Kom2 As Integer, Kom3 As String, Kom4 As Double
Dim i As Integer, x As Integer

    Set Sh1 = Sheets("HAM_VERI")
    Set Sh2 = Sheets("ISLENMIS VERI")
    Sh2.Cells.Clear
    Veri = Sh1.Range("A1:K" & Sh1.Range("A1").End(xlDown).Row).Value
    Sh2.Range("A1:K" & Sh1.Range("A1").End(xlDown).Row) = Veri
    Sh1.Range("A1:K" & Sh1.Range("A1").End(xlDown).Row).Copy Sh2.Range("A1")
    Sh2.Columns(8).Columns.Insert
    Sh2.Range("H1") = "İşlem Tutarı"
    x = UBound(Veri)
    For i = 2 To UBound(Veri)
        Sh2.Range("G" & i) = CDbl(Sh2.Range("G" & i))
        Sh2.Range("H" & i) = CDbl(Sh2.Range("H" & i))
        Sh2.Range("I" & i) = CDbl(Sh2.Range("I" & i))
        Sh2.Range("J" & i) = StrConv(Replace(Sh2.Range("J" & i), ",", ", "), vbProperCase)
        Sh2.Range("H" & i) = Sh2.Range("G" & i) - Sh2.Range("F" & i)
        Bul = InStr(1, Sh2.Range("J" & i), "Komisyon")
        If Bul > 0 Then
            Kom1 = InStr(Bul, Sh2.Range("J" & i), ":") + 1
            Kom2 = InStr(Bul, Sh2.Range("J" & i), ", Bloke")
            Kom3 = Replace(Mid(Sh2.Range("J" & i), Kom1, Kom2 - Kom1), " ", "")
            If Left(Kom3, 1) = "," Then Kom3 = "0" & Kom3
            Kom4 = 1 * Kom3
            x = x + 1
            Sh2.Range("A" & i, "G" & i).Copy Sh2.Range("A" & x, "G" & x)
            Sh2.Range("H" & x) = Kom4
            Sh2.Range("J" & x) = Range("D" & i) & " Fiş Nolu Tutar : " & Sh2.Range("G" & x)
            Sh2.Range("J" & x) = Sh2.Range("J" & x) & " Pos Komisyonu : " & Kom4
        End If
    Next i
    Sh2.Cells.VerticalAlignment = 2
    Sh2.Rows.RowHeight = 16
    Sh2.Rows(1).RowHeight = 20
    Sh2.Columns("A").NumberFormat = "dd/mm/yyyy"
    Sh2.Columns("B").NumberFormat = "dd/mm/yyyy hh:mm;@"
    Sh2.Columns("L").NumberFormat = "dd/mm/yyyy hh:mm;@"
    Sh2.Columns("F:I").NumberFormat = "#,##0.00;-#,##0.00;0.00"
    'Sıfır değerleri görünmesin isterseniz aşağıdaki satırı aktif edin
    'Sh2.Columns("F:I").NumberFormat = "#,##0.00;-#,##0.00;"
    Sh2.Columns("A:L").EntireColumn.AutoFit
    Sh2.Columns("A:L").InsertIndent 1
    Sh2.Columns("A:E").HorizontalAlignment = xlHAlignLeft
    Sh2.Columns("F:I").HorizontalAlignment = xlHAlignRight
    Sh2.Columns("J:L").HorizontalAlignment = xlHAlignLeft
    Sh2.Rows(1).Font.Bold = True
    For i = 1 To 12
    Sh2.Columns(i).ColumnWidth = Sh2.Columns(i).ColumnWidth + 1.5
    Next i
    Set Sh1 = Nothing: Set Sh2 = Nothing
End Sub

Ukde · 17 Eylül 2021

Hocam tam da istediğim gibi olmuş elinize sağlık. Sadece elimde şu an yaklaşık 500 satırlık bir HAM_VERI var gönderdiğiniz kodda hangi alanı değiştireyim ki bütün HAM_VERI yi dikkate alsın?

ÖmerFaruk · 17 Eylül 2021

Sütun sayısı ve hücre formatları örnekteki gibi olduğu sürece satır sayıs da 32767 de azsa bir sakınca yok.

Ukde · 17 Eylül 2021

Invalid procedure call or argument hatası verdi

ÖmerFaruk · 17 Eylül 2021

O hatayı nerede veriyor? Ekran görüntüsünü verirmisiniz?
Ya da 500 satırlık gerçek verinizin (içerik gerçek olmasın) olduğu dosyayı ekleyebilir misin

Ukde · 17 Eylül 2021

Hocam dosyayı yaklaşık 200 satırlık olarak aşağıdaki adrese yükledim.

https://dosyam.org/2EUy/V1.xlsx

ÖmerFaruk · 17 Eylül 2021

Sütun sayısı ve hücre formatları örnekteki gibi olduğu sürece satır sayıs da 32767 de azsa bir sakınca yok.
Size #4 nolu mesajda belirtmiştim.

Lütfen sorunuzu en başta tam sorunuz. Örnek dosya ekliyorsanız onu da tam belirtin.
Gönderdiğiniz dosyada ISLENEN VERI isimli bir sayfa dahil yok.
Sütun sayınız farklı
Alınacak verilerin olduğu ilk satır numaranız farklı
Kullandığının dosya yükleme sitesi sürekli reklam içeriyor, lütfen farklı bir yükleme sitesi kullanın.
Konu başlığınızla sorunuzun hiç ilgisi kalmadı.

Şimdi, bu gönderdiğiniz format hep aynı mı olacak? Değişecek bir şey varmı. İçerikler haricinde.

Yoksa şöyle bir durum mu var.
Muh Tarih ...ifadesi Üst Sol hücreyi temsil eder ve bunun sağındaki ardışık olu hücre sayısı sütun sayısını, altındaki ardışık dolu hücre sayısı da satır sayısını verir.

Ukde · 17 Eylül 2021

Son gönderdiğim format hep aynı olacak hocam.

Ukde · 17 Eylül 2021

Dosyayı google drive a yükledim.
Dosya Linki

ÖmerFaruk · 17 Eylül 2021

Dosyanızda HAM_VERI isimli sayfanın olması ve formatların da örnekteki gibi olması şart.

C++:

Sub Komisyonlar()
Dim Sh1 As Worksheet, Sh2 As Worksheet, Shf As Worksheet
Dim Kom1 As Integer, Kom2 As Integer, Kom3 As String, Kom4 As Double
Dim i As Integer, x As Integer

    Set Sh1 = Sheets("HAM_VERI")
    For Each Shf In Worksheets
        If Shf.Name = "ISLENMIS VERI" Then Shf.Cells.Clear: GoTo Devam
    Next Shf
    Sheets.Add(After:=Sh1).Name = "ISLENMIS VERI"
Devam:
    Set Sh2 = Sheets("ISLENMIS VERI")
    xRow = Sh1.Cells(Rows.Count, 1).End(3).Row
    Veri = Sh1.Range("A7:N" & xRow).Value
    Sh2.Range("A1:N" & xRow - 6) = Veri
    Sh2.Columns(8).Columns.Insert
    Sh2.Range("H1") = "İşlem Tutarı"
    x = UBound(Veri)
    For i = 2 To UBound(Veri)
        Sh2.Range("G" & i) = CDbl(Sh2.Range("G" & i))
        Sh2.Range("H" & i) = CDbl(Sh2.Range("H" & i))
        Sh2.Range("I" & i) = CDbl(Sh2.Range("I" & i))
        Sh2.Range("J" & i) = StrConv(Replace(Sh2.Range("J" & i), ",", ", "), vbProperCase)
        Sh2.Range("M" & i) = StrConv(Sh2.Range("M" & i), vbProperCase)
        Sh2.Range("N" & i) = StrConv(Sh2.Range("N" & i), vbProperCase)
        Sh2.Range("O" & i) = StrConv(Sh2.Range("O" & i), vbProperCase)
        
        Sh2.Range("H" & i) = Sh2.Range("G" & i) - Sh2.Range("F" & i)
        Bul = InStr(1, Sh2.Range("J" & i), "Komisyon ")
        If Bul > 0 Then
            Kom1 = InStr(Bul, Sh2.Range("J" & i), ":") + 1
            Kom2 = InStr(Bul, Sh2.Range("J" & i), ", Deneme")
            If Kom2 = 0 Then Kom2 = InStr(Bul, Sh2.Range("J" & i), ", Bloke No")
            If Kom2 = 0 Then Kom2 = InStr(Bul, Sh2.Range("J" & i), " Deneme")
            If Kom2 = 0 Then Kom2 = InStr(Bul, Sh2.Range("J" & i), " Bloke")

            Kom3 = Replace(Mid(Sh2.Range("J" & i), Kom1, Kom2 - Kom1), " ", "")
            If Left(Kom3, 1) = "," Then Kom3 = "0" & Kom3
            Kom4 = 1 * Kom3
            x = x + 1
            Sh2.Range("A" & i, "G" & i).Copy Sh2.Range("A" & x, "G" & x)
            Sh2.Range("H" & x) = Kom4
            Sh2.Range("J" & x) = Range("D" & i) & " Fiş Nolu Tutar : " & Sh2.Range("G" & x) + Kom4
            Sh2.Range("J" & x) = Sh2.Range("J" & x) & " Pos Komisyonu : " & Kom4
        End If
    Next i
    Sh2.Cells.VerticalAlignment = 2
    Sh2.Rows.RowHeight = 16
    Sh2.Rows(1).RowHeight = 20
    Sh2.Columns("A").NumberFormat = "dd/mm/yyyy hh:mm;@"
    Sh2.Columns("B").NumberFormat = "dd/mm/yyyy hh:mm;@"
    Sh2.Columns("L").NumberFormat = "dd/mm/yyyy hh:mm;@"
    Sh2.Columns("F:I").NumberFormat = "#,##0.00;-#,##0.00;0.00"
    'Sıfır değerleri görünmesin isterseniz aşağıdaki satırı aktif edin
    'Sh2.Columns("F:I").NumberFormat = "#,##0.00;-#,##0.00;"
    Sh2.Columns("A:O").EntireColumn.AutoFit
    Sh2.Columns("A:O").InsertIndent 1
    Sh2.Columns("A:E").HorizontalAlignment = xlHAlignLeft
    Sh2.Columns("F:I").HorizontalAlignment = xlHAlignRight
    Sh2.Columns("J:O").HorizontalAlignment = xlHAlignLeft
    Sh2.Rows(1).Font.Bold = True
    Sh2.Rows(1).RowHeight = 20
    For i = 1 To 15
    Sh2.Columns(i).ColumnWidth = Sh2.Columns(i).ColumnWidth + 1.5
    Next i
    Set Sh1 = Nothing: Set Sh2 = Nothing
End Sub

Ukde · 17 Eylül 2021

Elinize sağlık çok güzel oldu. Çok teşekkür ederim.

Ukde · 18 Eylül 2021

Hocam bu pos komisyonlarını - olarak atması için nerede hangi değişikliği yapabilirim?

ÖmerFaruk · 19 Eylül 2021

H sütunu için diyorsanız, aşağıdaki satırda gösterdiğim ilaveyi yapman yeterli

C++:

Sh2.Range("H" & x) = Kom4
'Bu satırı aşağıdaki gibi -1 ile çarpmalısınız
Sh2.Range("H" & x) = Kom4 * -1

Ukde · 21 Ekim 2021

Orjinali:

mustasil makbuz bedeli MUHAMMET ADIYAMAN Ziraat Mobil Telefon Havale

İşlenmiş Veri:

Mustasil Makbuz Bedeli Muhammet Adiyaman Ziraat Mobil Telefon Havale

Hocam burda Ham verideki MUHAMMET ADIYAMAN yazısını işlenmiş veriye atarken Muhammet Adiyaman olarak atıyor. Metni orjinal hali ile atmasını nasıl sağlayabiliriz?

ÖmerFaruk · 22 Ekim 2021

Bir aydan fazla olmuş soru cevaplanalı. Konuyu çok net hatırlamıyorum
Kodlarda aşağıdaki satırlarda yazım düzeni vardı. Arzu ediyorsanız yazım düzenleriyle ilgili bu satırları silebilirsiniz

C++:

Sh2.Range("M" & i) = StrConv(Sh2.Range("M" & i), vbProperCase)
Sh2.Range("N" & i) = StrConv(Sh2.Range("N" & i), vbProperCase)
Sh2.Range("O" & i) = StrConv(Sh2.Range("O" & i), vbProperCase)

Ukde · 22 Ekim 2021

Hocam bu satırları devre dışı bıraktım ama yine değişmedi. Farklı bir işlem olabilir mi?

ÖmerFaruk · 22 Ekim 2021

Benzer başka satıtr varsa onlara da bakmanız lazım.

Soru KIRP // PARÇAAL Fonksiyonu

Ukde

ÖmerFaruk

Destek Ekibi

Ukde

ÖmerFaruk

Destek Ekibi

Ukde

ÖmerFaruk

Destek Ekibi

Ukde

ÖmerFaruk

Destek Ekibi

Ukde

Ukde

ÖmerFaruk

Destek Ekibi

Ukde

Ukde

ÖmerFaruk

Destek Ekibi

Ukde

ÖmerFaruk

Destek Ekibi

Ukde

ÖmerFaruk

Destek Ekibi