- Katılım
- 5 Nisan 2007
- Mesajlar
- 413
- Excel Vers. ve Dili
- excel 2010 tr
Sayın korhan ayhan bu kodu vermişti:
fakat bu kod a10 ile a65536 arasında boş olan yani emekli sicili olmayanları siliyor şöyle bir şey yapılabilirmi?
örnek dosyada 87 ve 88 e yeni bir sütün ekledim
emekli sicil numaraları B SÜTÜNUNA KAYDI öyle bir kod olsunki aynı isimlere A SÜTÜNUNDA B SÜTÜNUNDA EMEKLİ SİCİL OLMAYANLARA( AYNI İSİMLERE kendiliğinden değişik numara versin ve onu baz alarak yine sıralama yapsın böylece emekli sicil nosu olmayanlar silinmesin?
nolur üstadlar yardım örnek dosyadaki bilgiler kendime aittir.
Sub DÜZENLE()
Sheets("Sayfa1").Select
Cells.Delete
[A1] = "SANDIK SİCİL NO"
[B1] = "ADI"
[C1] = "SOYADI"
SATIR = 2
On Error Resume Next
For SAYFA = 3 To Sheets.Count
Sheets(SAYFA).Range("A9:A65536").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
If Sheets(SAYFA).[A10] <> "" Then
SON_SATIR = Sheets(SAYFA).[A65536].End(3).Row
Sheets(SAYFA).Range("A10:C" & SON_SATIR).Copy Cells(SATIR, 1)
SATIR = [A65536].End(3).Row + 1
End If
Next
[A2:C65536].Sort Key1:=Range("B2"), Order1:=xlAscending
[A:C].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("F1"), Unique:=True
Range("E2") = 1
Range("E3") = 2
Range("E2:E3").AutoFill Destination:=Range("E2:E" & [F65536].End(3).Row)
Cells.EntireColumn.AutoFit
For X = 2 To [F65536].End(3).Row
For SAYFA = 3 To Sheets.Count
Set BUL = Sheets(SAYFA).[A:A].Find(Cells(X, "F"))
If Not BUL Is Nothing Then
ADRES = BUL.Address
Sheets(SAYFA).Cells(BUL.Row, "R") = Cells(X, "E")
Do
Set BUL = Sheets(SAYFA).[A:A].FindNext(BUL)
Loop While Not BUL Is Nothing And BUL.Address <> ADRES
End If
Next
Next
For SAYFA = 3 To Sheets.Count
Sheets(SAYFA).[A10:R65536].Sort Key1:=Sheets(SAYFA).[R10], Order1:=xlAscending
Next
For SAYFA = 3 To Sheets.Count
Sheets(SAYFA).Select
If [R65536].End(3).Value < Sheets("Sayfa1").[E65536].End(3).Value Then
For X = 1 To (Sheets("Sayfa1").[E65536].End(3).Value - [R65536].End(3).Value)
Cells([R65536].End(3).Row + 1, "R") = [R65536].End(3).Value + 1
Next
End If
For X = [R65536].End(3).Row To 10 Step -1
KONTROL = Cells(X, "R") - Cells(X - 1, "R")
If KONTROL <> 1 Then
Rows(X & ":" & X + KONTROL - 2).Insert
End If
fakat bu kod a10 ile a65536 arasında boş olan yani emekli sicili olmayanları siliyor şöyle bir şey yapılabilirmi?
örnek dosyada 87 ve 88 e yeni bir sütün ekledim
emekli sicil numaraları B SÜTÜNUNA KAYDI öyle bir kod olsunki aynı isimlere A SÜTÜNUNDA B SÜTÜNUNDA EMEKLİ SİCİL OLMAYANLARA( AYNI İSİMLERE kendiliğinden değişik numara versin ve onu baz alarak yine sıralama yapsın böylece emekli sicil nosu olmayanlar silinmesin?
nolur üstadlar yardım örnek dosyadaki bilgiler kendime aittir.
Sub DÜZENLE()
Sheets("Sayfa1").Select
Cells.Delete
[A1] = "SANDIK SİCİL NO"
[B1] = "ADI"
[C1] = "SOYADI"
SATIR = 2
On Error Resume Next
For SAYFA = 3 To Sheets.Count
Sheets(SAYFA).Range("A9:A65536").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
If Sheets(SAYFA).[A10] <> "" Then
SON_SATIR = Sheets(SAYFA).[A65536].End(3).Row
Sheets(SAYFA).Range("A10:C" & SON_SATIR).Copy Cells(SATIR, 1)
SATIR = [A65536].End(3).Row + 1
End If
Next
[A2:C65536].Sort Key1:=Range("B2"), Order1:=xlAscending
[A:C].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("F1"), Unique:=True
Range("E2") = 1
Range("E3") = 2
Range("E2:E3").AutoFill Destination:=Range("E2:E" & [F65536].End(3).Row)
Cells.EntireColumn.AutoFit
For X = 2 To [F65536].End(3).Row
For SAYFA = 3 To Sheets.Count
Set BUL = Sheets(SAYFA).[A:A].Find(Cells(X, "F"))
If Not BUL Is Nothing Then
ADRES = BUL.Address
Sheets(SAYFA).Cells(BUL.Row, "R") = Cells(X, "E")
Do
Set BUL = Sheets(SAYFA).[A:A].FindNext(BUL)
Loop While Not BUL Is Nothing And BUL.Address <> ADRES
End If
Next
Next
For SAYFA = 3 To Sheets.Count
Sheets(SAYFA).[A10:R65536].Sort Key1:=Sheets(SAYFA).[R10], Order1:=xlAscending
Next
For SAYFA = 3 To Sheets.Count
Sheets(SAYFA).Select
If [R65536].End(3).Value < Sheets("Sayfa1").[E65536].End(3).Value Then
For X = 1 To (Sheets("Sayfa1").[E65536].End(3).Value - [R65536].End(3).Value)
Cells([R65536].End(3).Row + 1, "R") = [R65536].End(3).Value + 1
Next
End If
For X = [R65536].End(3).Row To 10 Step -1
KONTROL = Cells(X, "R") - Cells(X - 1, "R")
If KONTROL <> 1 Then
Rows(X & ":" & X + KONTROL - 2).Insert
End If