soldan, sağdan, parçaal fonksiyonlarının makro karşılıkları

yusuf1284

Altın Üye
Katılım
17 Ocak 2015
Mesajlar
229
Excel Vers. ve Dili
Office Pro 2016 TR
Altın Üyelik Bitiş Tarihi
09-02-2028
A1 deki verinin başında fazladan bir boşluk vardı.
Kodlardaki deg tanımını aşağıdakiyle değiştiriniz.

deg = Trim(Sayfa1.Range("a1").Value)

.
Kusuruma bakmayın hocam atlamışım pdf dosyasından sayı ve konu yazan kısmı almaya çalışıyorum orada kendiliğinden boşluk varmış.
 
Katılım
15 Eylül 2012
Mesajlar
72
Excel Vers. ve Dili
2010 türkçe
Altın Üyelik Bitiş Tarihi
01-02-2025
Sayın Tevfik Bey aşağıdaki şekilde çözüm olur sanırım. Yalnız sürekli 40 karakter olmuyor almak istediğiniz. Belli bir kelime ya da farklı 2 kelime ayrım noktası ise split komutu da işinizi görecektir. Parça almak için.

Kod:
Sub Soldan_Al()
    ActiveSheet.Range("E10").ClearContents
    [E10] = Left(Range("E8"), 40)
    Call askm
End Sub

Sub askm()
For i = 1 To 40
    If Range("E8").Characters(Start:=i, Length:=1).Font.Name = "Symbol" Then
        Range("E10").Characters(Start:=i, Length:=1).Font.Name = "Symbol"
    End If
    If Range("E8").Characters(Start:=i, Length:=1).Font.Subscript = True Then
        Range("E10").Characters(Start:=i, Length:=1).Font.Subscript = True
    End If
Next
End Sub
Kod:
Sub Liste()

Dim arr As Variant, _
    diz As Variant, _
    i   As Long, _
    j   As Long, _
    s   As Integer

Application.ScreenUpdating = False

For s = 1 To Sheets.Count
    If Not Sheets(s).Name = "LİSTE" Then
        i = Sheets(s).Cells(Rows.Count, "B").End(3).Row
        j = j + (i - 3)
    End If
Next s

j = j + 1

Sheets("LİSTE").Range("A2:F" & Rows.Count).ClearContents    'EKRANI TEMİZLE
diz = Sheets("LİSTE").Range("A1:F" & j).Value               'LİSTE SAYFASINA LİSTELE

j = 1
For s = 1 To Sheets.Count
    If Not Sheets(s).Name = "LİSTE" Then
        i = Sheets(s).Cells(Rows.Count, "B").End(3).Row
        arr = Sheets(s).Range("B9:G" & i).Value
        For i = 1 To UBound(arr, 1)
            j = j + 1
            diz(j, 1) = arr(i, 1) 'KART KODU
            diz(j, 2) = arr(i, 3) 'PAREKENDE
            diz(j, 2) = arr(i, 5) 'PAREKENDE
            diz(j, 2) = arr(i, 6) 'PAREKENDE
        Next i
    End If
Next s
    
Sheets("LİSTE").Select

Range("A1").Resize(UBound(diz, 1), UBound(diz, 2)) = diz
Range("A2:C" & UBound(diz, 1)).Sort Key1:=Range("B1"), Key2:=Range("C1")
diz = Range("A1").CurrentRegion.Value
    
For i = 2 To UBound(diz, 1)
    If Not diz(i, 2) = diz(i - 1, 2) Then j = 0
    j = j + 1
    diz(i, 2) = j
Next i

Range("A1").Resize(UBound(diz, 1), UBound(diz, 2)) = diz
Application.ScreenUpdating = True

End Sub
#askm hocam merhabalar,
yukarıda çözümlediğiniz formata benzer bir listeyi makro ile elimdeki exelden sayfaların içinden belirlediğim sütunların listesini getirdikten sonra gelen listenin sadece soldan 7 karaktere ve maksimum 10 karaktere kadar olan rakamları nasıl listeleyebilirim acaba.
çözüm için yardımcı olabilirseniz sevinirim.
şimdiden çok teşekkür ederim yardımcı olacak arkadaşlara.
 
Son düzenleme:
Üst