Çözüldü Kod İsteği

cavanoos

cavanoos

Altın Üye
Katılım
17 Aralık 2008
Mesajlar
780
Excel Vers. ve Dili
Microsoft 365
Altın Üyelik Bitiş Tarihi
11-01-2026
Arkadaşlar;

Yapmak istediğim işlem B sütununda Pİ ve Tİ ile başlayan ve D sütununda YANLIŞ içermeyen satırları kopyalamak.
Kodun ilgili kısmı altta ama sonuç üretmiyor. Bu kodu nasıl yazarsak istediğim sonucu alırım.
YANLIŞ ibaresi formül sonucu geliyor bu arada


If (srcData(i, 2) Like "Pİ*" Or srcData(i, 2) Like "Tİ*") _
And srcData(i, 4) <> False Then
 
M

muhasebeciyiz

Altın Üye
Katılım
10 Şubat 2006
Mesajlar
1,173
Excel Vers. ve Dili
Office 2016
64 Bit
Altın Üyelik Bitiş Tarihi
21-12-2027
If (srcData(i, 2) Like "Pİ*" Or srcData(i, 2) Like "Tİ*") _
And InStr(1, srcData(i, 4), "YANLIŞ", vbTextCompare) = 0 Then

doğru çalışan kod bu olmalı

srcData(i, 2) Like "Pİ*" → B sütunu "Pİ" ile başlıyorsa
srcData(i, 2) Like "Tİ*" → veya "Tİ" ile başlıyorsa
InStr(...)=0 → D sütununda "YANLIŞ" kelimesi yoksa

Böylece istediğiniz kriterlere uyan satırlar kopyalanır.
 
Muzaffer Ali

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
6,698
Excel Vers. ve Dili
2021 Türkçe
cavanoos' Alıntı:
Arkadaşlar;

Yapmak istediğim işlem B sütununda Pİ ve Tİ ile başlayan ve D sütununda YANLIŞ içermeyen satırları kopyalamak.
Kodun ilgili kısmı altta ama sonuç üretmiyor. Bu kodu nasıl yazarsak istediğim sonucu alırım.
YANLIŞ ibaresi formül sonucu geliyor bu arada


If (srcData(i, 2) Like "Pİ*" Or srcData(i, 2) Like "Tİ*") _
And srcData(i, 4) <> False Then
Genişletmek için tıkla ...
Merhaba.

Kodda hata yok, belki kodun tamamını ve dosyanızı paylaşırsanız daha iyi kontrol edilebilir.
 
cavanoos

cavanoos

Altın Üye
Katılım
17 Aralık 2008
Mesajlar
780
Excel Vers. ve Dili
Microsoft 365
Altın Üyelik Bitiş Tarihi
11-01-2026
Muhasebeciyiz;

Kodu denedim ama değişen bir şey olmadı. Kodun tamamı alttadır.

Sub Garanti_yeni_kodlar()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

Dim wsCal As Worksheet, wsIn As Worksheet, wsPos As Worksheet, wsGar As Worksheet
Dim lastRow As Long, i As Long, cnt As Long
Dim srcData, outData()

Set wsCal = Worksheets("Çalışma")
Set wsIn = Worksheets("İçeri Alma")
Set wsPos = Worksheets("Garanti Başka Banka Pos Ücreti")
Set wsGar = Worksheets("Garanti")

'-------------------------------------------
' 1) Sayfaları temizleme
'-------------------------------------------
wsCal.Range("A2:E100000").ClearContents
wsIn.Range("A2:N100000").ClearContents
wsPos.Range("A2:C100000").ClearContents

'-------------------------------------------
' 2) Garanti ekstresini çalışma sayfasına aktar
'-------------------------------------------
wsCal.Range("A2:E50000").Value = wsGar.Range("A2:E50000").Value

'-------------------------------------------
' 3) Başka banka pos kullanım ücretlerini ayır
'-------------------------------------------
wsCal.Range("A1:E50000").AutoFilter Field:=2, Criteria1:="=*BAŞKA BANKA POSU*"

Dim dataPos
On Error Resume Next
dataPos = wsCal.Range("A2:C50000").SpecialCells(xlCellTypeVisible).Value
On Error GoTo 0

If Not IsEmpty(dataPos) Then
wsPos.Range("A2").Resize(UBound(dataPos), UBound(dataPos, 2)).Value = dataPos
End If

wsCal.AutoFilterMode = False

'-------------------------------------------
' 4) DİĞER yazan satırları sil
'-------------------------------------------
wsCal.Range("A1:E50000").AutoFilter Field:=4, Criteria1:="DİĞER"

On Error Resume Next
wsCal.Range("A2:E50000").SpecialCells(xlCellTypeVisible).EntireRow.Delete
On Error GoTo 0

wsCal.AutoFilterMode = False

'-------------------------------------------
' 5) YANLIŞ içeren mağazaları hariç tutmak için filtre (görsel)
'-------------------------------------------
'wsCal.Range("A1:E50000").AutoFilter Field:=4, Criteria1:="<>YANLIŞ"

'-------------------------------------------
' 6) Pİ ve Tİ ile başlayan iadeleri al
' (D SÜTUNU = "YANLIŞ" OLMAMALI)
'-------------------------------------------
lastRow = wsCal.Cells(wsCal.Rows.Count, "A").End(xlUp).Row
srcData = wsCal.Range("A1:E" & lastRow).Value

ReDim outData(1 To UBound(srcData), 1 To 13)
cnt = 0

For i = 2 To UBound(srcData)

If (srcData(i, 2) Like "Pİ*" Or srcData(i, 2) Like "Tİ*") _
And InStr(1, srcData(i, 4), "YANLIŞ", vbTextCompare) = 0 Then

cnt = cnt + 1

outData(cnt, 1) = srcData(i, 5)
outData(cnt, 2) = srcData(i, 1)
outData(cnt, 5) = srcData(i, 3)
outData(cnt, 13) = srcData(i, 1)

End If
Next i

If cnt > 0 Then
wsIn.Range("A2").Resize(cnt, 13).Value = outData
End If

wsCal.AutoFilterMode = False

'-------------------------------------------
' 7) Çalışma sayfasından PI/TI satırlarını sil
' (YANLIŞ olanlar zaten işlem görmeyecek)
'-------------------------------------------
For i = lastRow To 2 Step -1
If wsCal.Cells(i, 2).Value Like "Pİ*" Or wsCal.Cells(i, 2).Value Like "Tİ*" Then
If wsCal.Cells(i, 4).Value <> "YANLIŞ" Then
wsCal.Rows(i).Delete
End If
End If
Next i

'-------------------------------------------
' Bitti
'-------------------------------------------
MsgBox "Kayıt edildi."

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True

End Sub
 
Muzaffer Ali

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
6,698
Excel Vers. ve Dili
2021 Türkçe
Dosyayı da eklerseniz daha anlaşılır olur.
 
M

muhasebeciyiz

Altın Üye
Katılım
10 Şubat 2006
Mesajlar
1,173
Excel Vers. ve Dili
Office 2016
64 Bit
Altın Üyelik Bitiş Tarihi
21-12-2027
Kod: 
Sub Garanti_yeni_kodlar()

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

    Dim wsCal As Worksheet, wsIn As Worksheet, wsPos As Worksheet, wsGar As Worksheet
    Dim lastRow As Long, i As Long, cnt As Long
    Dim srcData, outData()
    Dim dataPos
    Dim Bval As Variant, Dval As Variant

    Set wsCal = Worksheets("Çalışma")
    Set wsIn = Worksheets("İçeri Alma")
    Set wsPos = Worksheets("Garanti Başka Banka Pos Ücreti")
    Set wsGar = Worksheets("Garanti")

    wsCal.Range("A2:E100000").ClearContents
    wsIn.Range("A2:N100000").ClearContents
    wsPos.Range("A2:C100000").ClearContents

    wsCal.Range("A2:E50000").Value = wsGar.Range("A2:E50000").Value

    wsCal.Range("A1:E50000").AutoFilter Field:=2, Criteria1:="=*BAŞKA BANKA POSU*"

    On Error Resume Next
    dataPos = wsCal.Range("A2:C50000").SpecialCells(xlCellTypeVisible).Value
    On Error GoTo 0

    If Not IsEmpty(dataPos) Then
        wsPos.Range("A2").Resize(UBound(dataPos), UBound(dataPos, 2)).Value = dataPos
    End If

    wsCal.AutoFilterMode = False

    wsCal.Range("A1:E50000").AutoFilter Field:=4, Criteria1:="DİĞER"

    On Error Resume Next
    wsCal.Range("A2:E50000").SpecialCells(xlCellTypeVisible).EntireRow.Delete
    On Error GoTo 0

    wsCal.AutoFilterMode = False

    lastRow = wsCal.Cells(wsCal.Rows.Count, "A").End(xlUp).Row
    srcData = wsCal.Range("A1:E" & lastRow).Value

    ReDim outData(1 To UBound(srcData), 1 To 13)
    cnt = 0

    For i = 2 To UBound(srcData)
        Bval = srcData(i, 2)
        Dval = srcData(i, 4)

        If (Bval Like "Pİ*" Or Bval Like "Tİ*") Then
            If NotYanlis(Dval) Then
                cnt = cnt + 1
                outData(cnt, 1) = srcData(i, 5)
                outData(cnt, 2) = srcData(i, 1)
                outData(cnt, 5) = srcData(i, 3)
                outData(cnt, 13) = srcData(i, 1)
            End If
        End If
    Next i

    If cnt > 0 Then
        wsIn.Range("A2").Resize(cnt, 13).Value = outData
    End If

    wsCal.AutoFilterMode = False

    For i = lastRow To 2 Step -1
        Bval = wsCal.Cells(i, 2).Value
        Dval = wsCal.Cells(i, 4).Value

        If (Bval Like "Pİ*" Or Bval Like "Tİ*") Then
            If NotYanlis(Dval) Then
                wsCal.Rows(i).Delete
            End If
        End If
    Next i

    MsgBox "Kayıt edildi."

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True

End Sub

Private Function NotYanlis(v As Variant) As Boolean
    If IsEmpty(v) Then
        NotYanlis = True
    ElseIf VarType(v) = vbBoolean Then
        NotYanlis = (v <> False)
    Else
        NotYanlis = (UCase$(CStr(v)) <> "YANLIŞ")
    End If
End Function
Denermisiniz
 
cavanoos

cavanoos

Altın Üye
Katılım
17 Aralık 2008
Mesajlar
780
Excel Vers. ve Dili
Microsoft 365
Altın Üyelik Bitiş Tarihi
11-01-2026
Üstadım çok teşekkür ederim :)
 
cavanoos

cavanoos

Altın Üye
Katılım
17 Aralık 2008
Mesajlar
780
Excel Vers. ve Dili
Microsoft 365
Altın Üyelik Bitiş Tarihi
11-01-2026
Başka excel dosyalarında da aynı sorunla karşılaşırsam, altta yazdığınız kod sorunu çözer değil mi ?

Private Function NotYanlis(v As Variant) As Boolean
If IsEmpty(v) Then
NotYanlis = True
ElseIf VarType(v) = vbBoolean Then
NotYanlis = (v <> False)
Else
NotYanlis = (UCase$(CStr(v)) <> "YANLIŞ")
End If
End Function
 
M

muhasebeciyiz

Altın Üye
Katılım
10 Şubat 2006
Mesajlar
1,173
Excel Vers. ve Dili
Office 2016
64 Bit
Altın Üyelik Bitiş Tarihi
21-12-2027
çok büyük ihtimalle her dosyada aynı sorunu çözer, çünkü fonksiyon üç farklı durumu kapsıyor
Formül sonucu False olan hücreleri, “YANLIŞ” metni içeren hücreleri, Diğer tüm normal veya boş hücreleri doğru şekilde ayırır.

Private Function NotYanlis(v As Variant) As Boolean
Dim t As String

If IsEmpty(v) Then
NotYanlis = True
ElseIf VarType(v) = vbBoolean Then
NotYanlis = (v <> False)
Else
t = Trim(UCase(CStr(v)))
t = Replace(t, "İ", "I") ' Türkçe karakter güvenliği
NotYanlis = (t <> "YANLIS") And (t <> "YANLIŞ")
End If
End Function

Üstadlık bir durumum yok sadece yardımcı olmaya çalışıyorum.Bunuda kullanabilirsin
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst