poetika
Altın Üye
- Katılım
- 6 Kasım 2005
- Mesajlar
- 127
- Excel Vers. ve Dili
- Excel 2010 Türkçe
- Altın Üyelik Bitiş Tarihi
- 30-09-2027
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Özür dilerim, paylaşıma açtım.Paylaştığınız dosyaya erişim vermelisiniz. Hatta foruma ekleyebilirsiniz. (Altın üyesiniz...)
Sub Islem()
On Error Resume Next
Application.ScreenUpdating = True
Dim msj As String, Bul As Range
msj = Kontrol
If msj <> "" Then
MsgBox msj
Exit Sub
End If
If MsgBox("Islem baslasin mi?", vbYesNo + vbDefaultButton2 + vbQuestion, "Onay") = vbNo Then Exit Sub
Temizle
Dim satirsayisi As Long, i As Long, bastarih As Date, bittarih As Date, borcturu As String
Dim metin As String, tutar As Double, tmpmudurluk As String, tmpiban As String, yeni As Long
Dim digertutar As Double
bastarih = Sayfa4.Range("G3")
bittarih = Sayfa4.Range("H3")
With Sayfa1.ListObjects(1)
satirsayisi = .ListRows.Count
Application.ScreenUpdating = False
For i = 1 To satirsayisi
If .DataBodyRange(i, 6) >= bastarih And .DataBodyRange(i, 6) <= bittarih Then
If .DataBodyRange(i, 3) = "Bursa" Then
borcturu = .DataBodyRange(i, 9)
metinasil = .DataBodyRange(i, 1) & " - " & .DataBodyRange(i, 2) & " - " & .DataBodyRange(i, 7) & " - " & " - " & .DataBodyRange(i, 3)
cezaevi = .DataBodyRange(i, 16)
tmpmudurluk = Mudurluk(borcturu)
tmpiban = Iban(borcturu)
Set Bul = Sayfa2.Range("A:A").Find(borcturu, , , xlWhole)
If Not Bul Is Nothing Then
If Bul.Offset(, 1) <> "CARİ" Then
If cezaevi > 0 Then
yeni = Sayfa4.ListObjects(1).ListRows.Add.Index
Sayfa4.ListObjects(1).DataBodyRange(yeni, 2) = tmpmudurluk
Sayfa4.ListObjects(1).DataBodyRange(yeni, 3) = tmpiban
Sayfa4.ListObjects(1).DataBodyRange(yeni, 4) = metinasil
Sayfa4.ListObjects(1).DataBodyRange(yeni, 5) = cezaevi
End If
End If
End If
End If
End If
Next
End With
Sayfa4.Rows("12:1000").AutoFit
YazdirmaAlani
Application.ScreenUpdating = True
MsgBox "Islem tamam!"
End Sub
Çok teşekkür ederim. Elinize sağlık.Deneyiniz.
C++:Sub Islem() On Error Resume Next Application.ScreenUpdating = True Dim msj As String, Bul As Range msj = Kontrol If msj <> "" Then MsgBox msj Exit Sub End If If MsgBox("Islem baslasin mi?", vbYesNo + vbDefaultButton2 + vbQuestion, "Onay") = vbNo Then Exit Sub Temizle Dim satirsayisi As Long, i As Long, bastarih As Date, bittarih As Date, borcturu As String Dim metin As String, tutar As Double, tmpmudurluk As String, tmpiban As String, yeni As Long Dim digertutar As Double bastarih = Sayfa4.Range("G3") bittarih = Sayfa4.Range("H3") With Sayfa1.ListObjects(1) satirsayisi = .ListRows.Count Application.ScreenUpdating = False For i = 1 To satirsayisi If .DataBodyRange(i, 6) >= bastarih And .DataBodyRange(i, 6) <= bittarih Then borcturu = .DataBodyRange(i, 9) metinasil = .DataBodyRange(i, 1) & " - " & .DataBodyRange(i, 2) & " - " & .DataBodyRange(i, 7) & " - " & " - " & .DataBodyRange(i, 3) cezaevi = .DataBodyRange(i, 16) tmpmudurluk = Mudurluk(borcturu) tmpiban = Iban(borcturu) Set Bul = Sayfa2.Range("A:A").Find(borcturu, , , xlWhole) If Not Bul Is Nothing Then If Bul.Offset(, 1) <> "CARİ" Then If cezaevi > 0 Then yeni = Sayfa4.ListObjects(1).ListRows.Add.Index Sayfa4.ListObjects(1).DataBodyRange(yeni, 2) = tmpmudurluk Sayfa4.ListObjects(1).DataBodyRange(yeni, 3) = tmpiban Sayfa4.ListObjects(1).DataBodyRange(yeni, 4) = metinasil Sayfa4.ListObjects(1).DataBodyRange(yeni, 5) = cezaevi End If End If End If End If Next End With Sayfa4.Rows("12:1000").AutoFit YazdirmaAlani Application.ScreenUpdating = True MsgBox "Islem tamam!" End Sub
Son olarak makroda;Deneyiniz.
C++:Sub Islem() On Error Resume Next Application.ScreenUpdating = True Dim msj As String, Bul As Range msj = Kontrol If msj <> "" Then MsgBox msj Exit Sub End If If MsgBox("Islem baslasin mi?", vbYesNo + vbDefaultButton2 + vbQuestion, "Onay") = vbNo Then Exit Sub Temizle Dim satirsayisi As Long, i As Long, bastarih As Date, bittarih As Date, borcturu As String Dim metin As String, tutar As Double, tmpmudurluk As String, tmpiban As String, yeni As Long Dim digertutar As Double bastarih = Sayfa4.Range("G3") bittarih = Sayfa4.Range("H3") With Sayfa1.ListObjects(1) satirsayisi = .ListRows.Count Application.ScreenUpdating = False For i = 1 To satirsayisi If .DataBodyRange(i, 6) >= bastarih And .DataBodyRange(i, 6) <= bittarih Then borcturu = .DataBodyRange(i, 9) metinasil = .DataBodyRange(i, 1) & " - " & .DataBodyRange(i, 2) & " - " & .DataBodyRange(i, 7) & " - " & " - " & .DataBodyRange(i, 3) cezaevi = .DataBodyRange(i, 16) tmpmudurluk = Mudurluk(borcturu) tmpiban = Iban(borcturu) Set Bul = Sayfa2.Range("A:A").Find(borcturu, , , xlWhole) If Not Bul Is Nothing Then If Bul.Offset(, 1) <> "CARİ" Then If cezaevi > 0 Then yeni = Sayfa4.ListObjects(1).ListRows.Add.Index Sayfa4.ListObjects(1).DataBodyRange(yeni, 2) = tmpmudurluk Sayfa4.ListObjects(1).DataBodyRange(yeni, 3) = tmpiban Sayfa4.ListObjects(1).DataBodyRange(yeni, 4) = metinasil Sayfa4.ListObjects(1).DataBodyRange(yeni, 5) = cezaevi End If End If End If End If Next End With Sayfa4.Rows("12:1000").AutoFit YazdirmaAlani Application.ScreenUpdating = True MsgBox "Islem tamam!" End Sub
güncelSon olarak makroda;
Sayfa1 de "Bursa" ili dışındaki satırların da pas geçmesini sağlayabilir miyiz?
Allah razı olsun.Önerdiğim kodu son talebinize göre revize ettim. Tekrar deneyiniz.