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

yusuf1284

Altın Üye
Katılım
17 Ocak 2015
Mesajlar
224
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ış.
 

comp_wolf

Altın Üye
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