Sözleşme numaralarını ayırma

[nurdann]

B sütününda () içinde yer alan kısmını g hücresine aktarmak istiyorum

 

[İhsan Tank]

B sütününda () içinde yer alan kısmını g hücresine aktarmak istiyorum

merhaba
boş bir module kopyalayarak deneyiniz

Sub paranteziçinial()
Dim a As Long
asi = MsgBox("Parantez İçindeki Verileri Çıkarıyorum Onaylıyor Musunuz_?", vbYesNo, "Onay")
If asi = vbNo Then Exit Sub
For a = 1 To Cells(65536, "B").End(xlUp).Row
Cells(a, "G") = Mid(Range("B" & a).Value, InStr(1, Range("B" & a).Value, "(", vbTextCompare) + 1, _
InStr(1, Range("B" & a).Value, ")", vbTextCompare) - 3)
Next
MsgBox "Parantez İçindeki Veriler Çıkarıldı", vbInformation, "Bitiş"
End Sub

 

[nurdann]

öncelikle ilginiz için teşekkür ederim.makroyu boş bi sayfada denedim ama bi hata verdi.

 

[İhsan Tank]

öncelikle ilginiz için teşekkür ederim.makroyu boş bi sayfada denedim ama bi hata verdi.

merhaba

Sub paranteziçinial()
Dim a As Long
asi = MsgBox("Parantez İçindeki Verileri Çıkarıyorum Onaylıyor Musunuz_?", vbYesNo, "Onay")
If asi = vbNo Then Exit Sub
For a = 2 To Cells(65536, "B").End(xlUp).Row
Cells(a, "G") = Mid(Range("B" & a).Value, InStr(1, Range("B" & a).Value, "(", vbTextCompare) + 1, _
InStr(1, Range("B" & a).Value, ")", vbTextCompare) - InStr(1, Range("B" & a).Value, "(", vbTextCompare) - 1)
Next
MsgBox "Parantez İçindeki Veriler Çıkarıldı", vbInformation, "Bitiş"
End Sub

bunu kullanınız

 

[sonsuzkalp]

ihsan hocam ben bunu denedim

asi = MsgBox("Parantez İçindeki Verileri Çıkarıyorum Onaylıyor Musunuz_?", vbYesNo, "Onay")

burdaki asi değişkeni tanımlı değil diyor neden?

 

[İhsan Tank]

ihsan hocam ben bunu denedim

asi = MsgBox("Parantez İçindeki Verileri Çıkarıyorum Onaylıyor Musunuz_?", vbYesNo, "Onay")

burdaki asi değişkeni tanımlı değil diyor neden?

bende böyle bir hata vermiyor
siz dosya ekler misiniz

 

[Necdet]

ihsan hocam ben bunu denedim

asi = MsgBox("Parantez İçindeki Verileri Çıkarıyorum Onaylıyor Musunuz_?", vbYesNo, "Onay")

burdaki asi değişkeni tanımlı değil diyor neden?

Dim satırını aşağıaki gibi düzenleyiniz.

Dim a As Long, [B][COLOR=red]asi As String
[/COLOR][/B]

 

[mustafaine1]

sanirim option explicit var kodunuzun basinda Necdet Beyin dedigi gibi ayarlarsaniz kodunuzu hata yok olcaktir..

 

[sonsuzkalp]

çok teşekkür ederim hocalarım baya bi hata alıyordum bi tanımlamadan dolayı zorlanıyordum

tekrar teşekkürler

 

[nurdann]

İhsan bey son bişey daha sorucam bazı satırlarda () içi olarak bi bilgi yer almıyoo ve anladığım kadarıyla () bilgi bulamadığı için hata veriyoo diğerlerinide g sütününa çıkartmıyor bunun bir çözümü varmı acaba?

 

[Necdet]

Merhaba,

İhsan bey forumda şu an yok sanırım, size yarıdmcı olmak amacıyla kodları uzattım ve açıklamalar koydum, umarım işinize yarar.

Sub Parantez()
    Dim i   As Long, _
        Bs  As Integer, _
        Bt  As Integer, _
        Uz  As Integer, _
        Adt As Long
        
    Application.ScreenUpdating = False
    Range("G:G").ClearContents
    
    For i = 1 To Cells(Rows.Count, "B").End(3).Row
        Bs = InStr(1, Cells(i, "B"), "(", vbTextCompare)    '( karakterinin başlangıc pozisyonu
        Bt = InStr(1, Cells(i, "B"), ")", vbTextCompare)    ') karakterinin başlangıç pozisyonu
        If Bs > 0 And Bt > 0 Then   ' Her iki karakter var ise
            Bs = Bs + 1             ' ( sonrası alıcak pozisyon
            Uz = Bt - Bs            ' Alınacak Karakter Sayısı
            If Uz > 0 Then
                Cells(i, "G") = Mid(Cells(i, "B"), Bs, Uz)
                Adt = Adt + 1
            End If
        End If
    Next i
    
    If Adt = 0 Then
        MsgBox "Parantezli İşlem Yok", vbCritical, "N. YEŞERTENER, [URL="http://www.excel.web.tr/"]www.excel.web.tr[/URL]"
    Else
        MsgBox Adt & " Adet Paranteziçi İşlem Yapıldı...", vbInformation, "N. YEŞERTENER, [URL="http://www.excel.web.tr/"]www.excel.web.tr[/URL]"
    End If
    
    Application.ScreenUpdating = True
    
End Sub

 

[nurdann]

Merhabalar necdet bey yardımlarınız için ihsan beyede sizde çok teşekkür ediyorum gerçekten çok işime yaradı.İyi çalışmalar kolay gelsin..