- Katılım
- 10 Ocak 2018
- Mesajlar
- 681
- Excel Vers. ve Dili
-
Microsoft Office 2024
Google Sheets
- Altın Üyelik Bitiş Tarihi
- 19-12-2026
Merhaba,
Buradaki konuya istinaden farklı bir uygulama için tekrardan yardımlarınıza ihtiyacım var.
Öncelikle ilgili kod çalışıyor. Sadece ufak bir değişiklik yapılması gerekli. Veriler gelirken ufak bir hata oluşmakta maalesef geç fark ettim.
Uygulama şu şekilde;
* NetcadRapor sayfasındaki L sütununda eğer TC var ise MernisListe sayfası G sütununda arama yapıyor ve bu satırla birlikte altındaki satırları ÖnÇalışma sayfasına kopyalıyor.
*NetcadRapor sayfasındaki L sütunu boş, 0 veya TC YOK ise bu satırdaki veriyi ÖnÇalışma sayfasına kopyalıyor.
Buraya kadar problemsiz şekilde çalışmaktadır.
( @Ömer beyin eline sağlık. )
Düzeltilmesi gereken;
"* NetcadRapor sayfasındaki L sütununda eğer TC var ise MernisListe sayfası G sütununda arama yapıyor ve bu satırla birlikte altındaki satırları ÖnÇalışma sayfasına kopyalıyor." bu uygulamayı yaparken örneğe eklemiş olduğum dosyada renk ve not ekleyerek de açıklamaya çalıştım;
Normal şartlarda MernisListe sayfasında arama yaparken boş hücreden sonra gelen (sarı renkli ilk TC'ler) ilgili TC numarasını baz alması lazım.
Fakat aynı TC numarası farklı bir kişinin varisi olarak varsa ve oda listede daha önde ise onu baz alıyor ve altındaki ilgisiz kişileri de ÖnÇalışma sayfasına aktarılıyor.
*** Bu hata sanırım arama işlemi yapılırken eğer MernisListe sayfası G sütununda ilgili TC noyu bulunca bir yukarı hücre dolu ise atlasın, BOŞ ise kabul edip kopyalasın şeklinde olursa düzelebilir. ***
Bahsettiğim şekilde revizyon yapılabilir mi? Yardımcı olabilir misiniz?
Teşekkür ederim.
Buradaki konuya istinaden farklı bir uygulama için tekrardan yardımlarınıza ihtiyacım var.
Öncelikle ilgili kod çalışıyor. Sadece ufak bir değişiklik yapılması gerekli. Veriler gelirken ufak bir hata oluşmakta maalesef geç fark ettim.
Uygulama şu şekilde;
* NetcadRapor sayfasındaki L sütununda eğer TC var ise MernisListe sayfası G sütununda arama yapıyor ve bu satırla birlikte altındaki satırları ÖnÇalışma sayfasına kopyalıyor.
*NetcadRapor sayfasındaki L sütunu boş, 0 veya TC YOK ise bu satırdaki veriyi ÖnÇalışma sayfasına kopyalıyor.
Buraya kadar problemsiz şekilde çalışmaktadır.
( @Ömer beyin eline sağlık. )
Düzeltilmesi gereken;
"* NetcadRapor sayfasındaki L sütununda eğer TC var ise MernisListe sayfası G sütununda arama yapıyor ve bu satırla birlikte altındaki satırları ÖnÇalışma sayfasına kopyalıyor." bu uygulamayı yaparken örneğe eklemiş olduğum dosyada renk ve not ekleyerek de açıklamaya çalıştım;
Normal şartlarda MernisListe sayfasında arama yaparken boş hücreden sonra gelen (sarı renkli ilk TC'ler) ilgili TC numarasını baz alması lazım.
Fakat aynı TC numarası farklı bir kişinin varisi olarak varsa ve oda listede daha önde ise onu baz alıyor ve altındaki ilgisiz kişileri de ÖnÇalışma sayfasına aktarılıyor.
*** Bu hata sanırım arama işlemi yapılırken eğer MernisListe sayfası G sütununda ilgili TC noyu bulunca bir yukarı hücre dolu ise atlasın, BOŞ ise kabul edip kopyalasın şeklinde olursa düzelebilir. ***
Bahsettiğim şekilde revizyon yapılabilir mi? Yardımcı olabilir misiniz?
Teşekkür ederim.
Kod:
Sub tc_bul_yeni()
Dim S1 As Worksheet, S2 As Worksheet, S3 As Worksheet, son As Long
Dim i As Long, c As Range, Adr As String, sat As Long, j As Long, s As Long, k As Integer
Set S1 = Sheets("NetcadRapor")
Set S2 = Sheets("MernisListe")
Set S3 = Sheets("ÖnÇalışma")
son = S2.Cells(Rows.Count, "G").End(xlUp).Row
Application.ScreenUpdating = False
Application.DisplayAlerts = False
S3.Rows("2:" & Rows.Count).Clear
sat = 2
For i = 2 To S1.Cells(Rows.Count, "F").End(xlUp).Row
Set c = S2.[G:G].Find(S1.Cells(i, "L"), , xlValues, xlWhole)
If Not c Is Nothing And S1.Cells(i, "L") <> "" Then
For j = c.Row To son
If s = 0 Then s = sat
If Len(S2.Cells(j, "G")) <> 11 Then
Exit For
End If
S3.Cells(sat, "C") = S1.Cells(i, "A")
S3.Cells(sat, "D") = S1.Cells(i, "B")
S3.Cells(sat, "E") = S1.Cells(i, "C")
S3.Cells(sat, "H") = S2.Cells(j, "B")
S3.Cells(sat, "I") = S2.Cells(j, "C")
S3.Cells(sat, "F") = S1.Cells(i, "D")
S3.Cells(sat, "G") = S1.Cells(i, "E")
S3.Cells(sat, "J") = S1.Cells(i, "H")
S3.Cells(sat, "K") = S1.Cells(i, "I")
S3.Cells(sat, "L") = S1.Cells(i, "J")
S3.Cells(sat, "M") = S1.Cells(i, "K")
S3.Cells(sat, "T") = S2.Cells(j, "G")
S3.Cells(sat, "U") = S2.Cells(j, "F")
S3.Cells(sat, "V") = S2.Cells(j, "H")
S3.Cells(sat, "W") = S2.Cells(j, "I")
sat = sat + 1
Next j
For k = 3 To 13
If k < 8 Or k > 9 Then
S3.Cells(s, k).Resize(sat - s, 1).MergeCells = True
S3.Cells(s, k).Resize(sat - s, 1).VerticalAlignment = xlCenter
End If
Next k
s = 0
Else
S3.Cells(sat, "C") = S1.Cells(i, "A")
S3.Cells(sat, "D") = S1.Cells(i, "B")
S3.Cells(sat, "E") = S1.Cells(i, "C")
S3.Cells(sat, "H") = S1.Cells(i, "F")
S3.Cells(sat, "I") = S1.Cells(i, "G")
S3.Cells(sat, "F") = S1.Cells(i, "D")
S3.Cells(sat, "G") = S1.Cells(i, "E")
S3.Cells(sat, "J") = S1.Cells(i, "H")
S3.Cells(sat, "K") = S1.Cells(i, "I")
S3.Cells(sat, "L") = S1.Cells(i, "J")
S3.Cells(sat, "M") = S1.Cells(i, "K")
S3.Cells(sat, "T") = S1.Cells(i, "L")
sat = sat + 1
End If
sat = sat + 1
Next i
S3.Select
Range("A2:AD" & sat - 2).Borders.LineStyle = 1
MsgBox "Aktarım Tamamlandı.", vbInformation
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
