• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

MAKRO VERİ SIRALAMA BELİRLİ VERİ DİZİSİ İÇİNDE

S

sahin.gungor

Katılım
30 Ocak 2021
Mesajlar
21
Excel Vers. ve Dili
Excel 2019 - VBA
Merhabalar

A2 hücresinden başlayıp G hücre aralığında verilerim var. Bu veri aralığında A hücresinde değer değiştiğinde bir boşluk ekliyorum sorum su eklenen her bir boşluktan sonra veri dizi içinde kalan verileri g sütünuna göre veri dizi içinde kalan verileri sıralasın.

Teşekkürler
 
sahin.gungor' Alıntı:
Merhabalar

A2 hücresinden başlayıp G hücre aralığında verilerim var. Bu veri aralığında A hücresinde değer değiştiğinde bir boşluk ekliyorum sorum su eklenen her bir boşluktan sonra veri dizi içinde kalan verileri g sütünuna göre veri dizi içinde kalan verileri sıralasın.

Teşekkürler
Genişletmek için tıkla ...
Hiç bir şey anlamadım. Türkçeyi doğru kullanarak daha anlaşılır yazarsanız daha iyi olur.
 
örnek vermek gerekirse

Aşağıdaki tabloda gördüğünüzde üzere a sütünundaki artarda sıralanan verileri değişince bir boşluk ekleniyor. boş satırdan sonra ki verileri sıralayıp tekrar bir sonraki veri aralığını sıralasın sonra boşluktan sonraki veri aralığını sıralasın taki sıralanacak veri bitene kadaqr

A B C
A D E
A F G

B T P
B S I
 
Merhaba.
Aşağıdaki kodu deneyiniz.
Kod: 
Sub TEST()
    Dim IlkSatir As Long
    Dim SonSatir As Long
    IlkSatir = 2
    Application.ScreenUpdating = False
    Do
        SonSatir = Cells(IlkSatir, "C").End(xlDown).Row
        With ActiveSheet.Sort
            .SortFields.Clear
            .SortFields.Add2 Key:=Range("C" & IlkSatir & ":C" & SonSatir), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .SetRange Range("A" & IlkSatir & ":C" & SonSatir)
            .Header = xlGuess
            .Apply
        End With
        IlkSatir = Cells(SonSatir, "C").End(xlDown).Row
    Loop Until IlkSatir = Rows.Count
    Application.ScreenUpdating = True
End Sub
 
Makro ile düşeyara yaptım ^yok olarak gelen hatalar var bunlar yazmasın eğer hata olursa boş gelsin istiyorum ( G sutunu için )
 
Son düzenleme:
Private Sub CommandButton1_Click()

Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Üretim Emri Sayfası - SubAssemb")

Dim lr As Integer
lr = sh.Range("A" & Application.Rows.Count).End(xlUp).Row

sh.Range("g2").Value = "=VLOOKUP(C2,'Database'!F:I,4,0)"

sh.Range("g2:g" & lr).FillDown
sh.Range("g2:g" & lr).Copy
sh.Range("g2:g" & lr).PasteSpecial xlPasteValues

Application.CutCopyMode = False
end sub
 
Bu şekilde yazın.

Kod: 
Private Sub CommandButton1_Click()

Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Üretim Emri Sayfası - SubAssemb")
Dim lr As Integer
lr = sh.Range("A" & Application.Rows.Count).End(xlUp).Row

sh.Range("g2").Value = "=IFERROR(VLOOKUP(C2,'Database'!F:I,4,0);"")"

sh.Range("g2:g" & lr).FillDown
sh.Range("g2:g" & lr).Copy
sh.Range("g2:g" & lr).PasteSpecial xlPasteValues

Application.CutCopyMode = False

End sub
 
if error eklediğimde düşeyarayıda yapmıyor ama

İSTEDİĞİM DÜŞEYARA YAĞTIGIMDA YOK OLARAK HATA VEREN HÜCRELER VAR BUNLAR GELMESİN BUNUN YERİNE BOŞ YAZSIN
 
volki_112' Alıntı:
Bu şekilde yazın.

Kod: 
Private Sub CommandButton1_Click()

Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Üretim Emri Sayfası - SubAssemb")
Dim lr As Integer
lr = sh.Range("A" & Application.Rows.Count).End(xlUp).Row

sh.Range("g2").Value = "=IFERROR(VLOOKUP(C2,'Database'!F:I,4,0);"")"

sh.Range("g2:g" & lr).FillDown
sh.Range("g2:g" & lr).Copy
sh.Range("g2:g" & lr).PasteSpecial xlPasteValues

Application.CutCopyMode = False

End sub
Genişletmek için tıkla ...

Merhaba if error çalışmadı ama yok yazdıgı içinmi çalışmıyor acaba
 
sahin.gungor' Alıntı:
Merhaba if error çalışmadı ama yok yazdıgı içinmi çalışmıyor acaba
Genişletmek için tıkla ...
if error satırını bu şekilde değiştirir misin deneyip dönüş yapınız. satırı kopyalayıp kendi satırında iferror yerine yapıştır

sh.Range("g2").Formula = "=IFERROR(VLOOKUP(C2,'Database'!F:I,4,0),"""")"
 
Muzaffer Ali' Alıntı:
Merhaba.
Aşağıdaki kodu deneyiniz.
Kod: 
Sub TEST()
    Dim IlkSatir As Long
    Dim SonSatir As Long
    IlkSatir = 2
    Application.ScreenUpdating = False
    Do
        SonSatir = Cells(IlkSatir, "C").End(xlDown).Row
        With ActiveSheet.Sort
            .SortFields.Clear
            .SortFields.Add2 Key:=Range("C" & IlkSatir & ":C" & SonSatir), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .SetRange Range("A" & IlkSatir & ":C" & SonSatir)
            .Header = xlGuess
            .Apply
        End With
        IlkSatir = Cells(SonSatir, "C").End(xlDown).Row
    Loop Until IlkSatir = Rows.Count
    Application.ScreenUpdating = True
End Sub
Genişletmek için tıkla ...
Bu kod tam olarak işimi görmedi sıralamayı yaptı ama benim isteiğim aralıklarda yapmadı örnek olsun diye bir resim ekliyorum.

Resimde de göreceğiniz üzere A SUTUTUNA GORE SATIR BOLME İŞLEMİ YAPIYORUM VE HER SATIR BAŞLANGICINDA 1 BOŞLUK BIRAKIYORUM DAHA SONRA VLOOKUP İLE G SUTUNDAKİ HÜCRELERİ GETİRİYORUN. SORUM SU BOŞ SATIRDAN ÖNCEKİ TÜM VERİ ARALIĞINI VE BİRDEN FAZLA VERİ ARALIĞIM VAR G SUTUNUNA GÖRE NASIL SIRALATIRIM TEŞEKKÜRLER
 
sahin.gungor' Alıntı:
Bu kod tam olarak işimi görmedi sıralamayı yaptı ama benim isteiğim aralıklarda yapmadı örnek olsun diye bir resim ekliyorum.

Resimde de göreceğiniz üzere A SUTUTUNA GORE SATIR BOLME İŞLEMİ YAPIYORUM VE HER SATIR BAŞLANGICINDA 1 BOŞLUK BIRAKIYORUM DAHA SONRA VLOOKUP İLE G SUTUNDAKİ HÜCRELERİ GETİRİYORUN. SORUM SU BOŞ SATIRDAN ÖNCEKİ TÜM VERİ ARALIĞINI VE BİRDEN FAZLA VERİ ARALIĞIM VAR G SUTUNUNA GÖRE NASIL SIRALATIRIM TEŞEKKÜRLER
Genişletmek için tıkla ...
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst