seddur
Altın Üye
- Katılım
- 12 Nisan 2012
- Mesajlar
- 531
- Excel Vers. ve Dili
- Microsoft office professional plus 2019
- Altın Üyelik Bitiş Tarihi
- 18-12-2024
Merhaba.Aşağıdaki kod ile Liste sayfası L sutunundaki benzersiz verileri Rapor sayfası B ve C sutunlarına kaydetiyorum.Ancak toplam 20 sutuna kayıt yapacağmdan If Then Else kullanmadan kısaca kodu nasıl düzenleyebiliriz.?
Dim S1, S2 As Worksheet
Dim i As Long, son As Long, son1 As Long, son2 As Long, sat As Long
Set S1 = Sheets("Liste")
Set S2 = Sheets("Rapor")
Application.ScreenUpdating = False
S2.Range("B2:K20").ClearContents
son = S1.[L65536].End(3).Row
sat = 2
For i = 2 To son
If WorksheetFunction.CountIf(S1.Range("L2:L" & i), S1.Cells(i, "L")) = 1 Then
If S1.Cells(i, 1) = "1" Then
S2.Cells(sat, "b").End(3)(2, 1) = S1.Cells(i, "L")
Else
If S1.Cells(i, 1) = "2" Then
S2.Cells(sat, "c").End(3)(2, 1) = S1.Cells(i, "L")
sat = sat + 1
End If: End If: End If
Next
Dim S1, S2 As Worksheet
Dim i As Long, son As Long, son1 As Long, son2 As Long, sat As Long
Set S1 = Sheets("Liste")
Set S2 = Sheets("Rapor")
Application.ScreenUpdating = False
S2.Range("B2:K20").ClearContents
son = S1.[L65536].End(3).Row
sat = 2
For i = 2 To son
If WorksheetFunction.CountIf(S1.Range("L2:L" & i), S1.Cells(i, "L")) = 1 Then
If S1.Cells(i, 1) = "1" Then
S2.Cells(sat, "b").End(3)(2, 1) = S1.Cells(i, "L")
Else
If S1.Cells(i, 1) = "2" Then
S2.Cells(sat, "c").End(3)(2, 1) = S1.Cells(i, "L")
sat = sat + 1
End If: End If: End If
Next
Son düzenleme: