Soru Sıralama sırasında kasma.

yasarcan

Altın Üye
Katılım
30 Nisan 2016
Mesajlar
59
Excel Vers. ve Dili
2007
17000 satırlık bir veritabanım var. Bunlardan bazı satırları gizleyerek bazı sütunlara göre büyükten küçüğe sıralama yapıyorum.
yine bir butonla orjinal küçükten büyüğe verdiğim sıra numarasına göre orjinal hale geri getiriyorum

sorum şu:
orjinal sıra numarası verdiğimde 1 den 17000 e; vba larım müthiş kasıyor. nasıl bir yöntem uygulamalıyım?
 

Korhan Ayhan

Moderatör
Yönetici
Katılım
15 Mart 2005
Mesajlar
32,305
Excel Vers. ve Dili
Ofis 365 Tr-64 Bit
Ofis 2010 Tr-En 32 Bit
Siz hangi yöntemi kullanıyorsunuz?
 

yasarcan

Altın Üye
Katılım
30 Nisan 2016
Mesajlar
59
Excel Vers. ve Dili
2007
hocam şöyle:
a sütunu boş
b sütununda puan var
c sütununda 1-den 17000 e sıralama var.

vba ile büyükten küçüğe (b deki puana göre sıralıyorum)
vba ile a sütununa sıra numarası veriyorum çıktı alıyorum
a sütunu siliyorum makroyla.
vba ile küçükten büyüğe ( buradaki değer orjinale dönmesi için sabit) sıralayarak ilk hale dönerek çıkıyorum.

burada hiçbir sorun yok. başka bir sayfada satır gizleme vba sı var. oda güzel çalışıyor.
fakat c sütununda 1 den 17000 e sabit numara yazınca inanılmaz kasıyor. boş bırakırsam çok hızlı çalışıyor.
 

Korhan Ayhan

Moderatör
Yönetici
Katılım
15 Mart 2005
Mesajlar
32,305
Excel Vers. ve Dili
Ofis 365 Tr-64 Bit
Ofis 2010 Tr-En 32 Bit
Bende kasma durumunda kullandığınız yapıyı soruyorum. O bölümde hangi kodu kullanıyorsunuz?
 

yasarcan

Altın Üye
Katılım
30 Nisan 2016
Mesajlar
59
Excel Vers. ve Dili
2007
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Sayfalar
    Dim DahilBak As Integer
    Dim Dahil As Boolean
    Dim syf As Worksheet
    Dim Temizle As Boolean
    Sayfalar = Array("ANASAYFA") 
    Application.EnableEvents = False
    If Target.Text = "a" Then
        Cells(Target.Row, 3) = ""
        Cells(Target.Row, 4) = ""
        Cells(Target.Row, 5) = ""
        Cells(Target.Row, Target.Column) = "a"
    ElseIf Target.Text = "" Then
        Temizle = True
    End If
    For Each syf In ThisWorkbook.Worksheets

        Dahil = False
        For DahilBak = 0 To UBound(Sayfalar)
            If syf.Name = Sayfalar(DahilBak) Then
                Dahil = True
                Exit For
            End If
        Next
        If Dahil = True Then
            If Not Intersect(Target, Range("C:E", "H:H")) Is Nothing Then
                Select Case Target.Column
                    Case 3 'Evet
                        syf.Rows((Target.Row * 2) + 7).EntireRow.Hidden = True
                        syf.Rows((Target.Row * 2) + 8).EntireRow.Hidden = False
                    Case 4 'Hayır
                        syf.Rows((Target.Row * 2) + 7).EntireRow.Hidden = False
                        syf.Rows((Target.Row * 2) + 8).EntireRow.Hidden = True
                    
                    Case 5 ' Uygulanamaz
                        syf.Rows((Target.Row * 2) + 7).EntireRow.Hidden = True
                        syf.Rows((Target.Row * 2) + 8).EntireRow.Hidden = True
                    
                End Select
                
                If Temizle Then
                    syf.Rows((Target.Row * 2) + 7).EntireRow.Hidden = False
                    syf.Rows((Target.Row * 2) + 8).EntireRow.Hidden = False
                End If
            End If
        End If
    Next
    Application.EnableEvents = True
End Sub
 

yasarcan

Altın Üye
Katılım
30 Nisan 2016
Mesajlar
59
Excel Vers. ve Dili
2007
Hocam kodun dışında bir kolona sabit numara vermeyi denicem.

denedim olmadı zaten kod tüm satırlarda çalıştığı için dışınada çıkamadım.
 
Son düzenleme:

Korhan Ayhan

Moderatör
Yönetici
Katılım
15 Mart 2005
Mesajlar
32,305
Excel Vers. ve Dili
Ofis 365 Tr-64 Bit
Ofis 2010 Tr-En 32 Bit
Ben sizden sıra numarası veren kod bloğunu istemiştim. Neyse anlaşamadık.

Aşağıdaki kod tek hamlede koşulsuz olarak A1:A20000 hücrelerine sıra numarası verir.

Eğer aradığınız bu değilse örnek dosya ekleyerek yapmak istediğiniz işlemi açıklayınız.

C++:
Option Explicit

Sub Sira_No()
    Range("A1:A20000") = Evaluate("ROW(A1:A20000)")
End Sub
 

yasarcan

Altın Üye
Katılım
30 Nisan 2016
Mesajlar
59
Excel Vers. ve Dili
2007
sıra
Ben sizden sıra numarası veren kod bloğunu istemiştim. Neyse anlaşamadık.

Aşağıdaki kod tek hamlede koşulsuz olarak A1:A20000 hücrelerine sıra numarası verir.

Eğer aradığınız bu değilse örnek dosya ekleyerek yapmak istediğiniz işlemi açıklayınız.

C++:
Option Explicit

Sub Sira_No()
    Range("A1:A20000") = Evaluate("ROW(A1:A20000)")
End Sub
c numarasını elle giriyorum hocam.
a daki numarayıda

Private Sub CommandButton3_Click()
Dim i As Long, x As Long
For i = 11 To Range("B65536").End(3).Row
On Error Resume Next
If (Range("b" & i).Value <> "") And Rows(i).RowHeight > 0 Then
Cells(Rows(i).Row, "A").Value = x + 1
x = x + 1
End If
Next i
x = Empty
End Sub

bununla veriyorum. numara verirken kasma yok.
diğer sayfadaki kodu mumaralar üzerindeyken çalıştırınca kasma oluyo
numaralar yokken sütunlar boşken kasma yok.

verdiğiniz kodu deniyeyim
 

reosman

Altın Üye
Katılım
26 Nisan 2021
Mesajlar
50
Excel Vers. ve Dili
TR 2019
Option Explicit

Sub Sira_No()
Range("A1:A20000") = Evaluate("ROW(A1:A20000)")
End Sub

Hocam bu kodu son dolu satıra kadar ver nasıl yaparız ?
 

Seyit Tiken

Uzman
Uzman
Katılım
23 Ağustos 2005
Mesajlar
4,589
Excel Vers. ve Dili
Excel : 2010
Bu şekilde deneyiniz.
Kod:
Sub SıraNo()
With Range("A1:A" & Cells(Rows.Count, "B").End(3).Row)
.Formula = "=Row()"
.Value = .Value
End With
End Sub
 

Seyit Tiken

Uzman
Uzman
Katılım
23 Ağustos 2005
Mesajlar
4,589
Excel Vers. ve Dili
Excel : 2010
Kod Günceleme :
Kod:
Sub SıraNo()
For h = 1 To Cells(Rows.Count, "A").End(3).Row
Cells(h, "A") = ""
Next
With Range("A1:A" & Cells(Rows.Count, "B").End(3).Row)
.Formula = "=Row()"
.Value = .Value
End With
End Sub
 
Üst