sıralama

[burhanyildirim11]

iyi geceler arkadaşlar



örnek dosya yükledim.

a deki isimlerin karşılıgında b sutununda negatıf ve pozıtıf sayılar var , sutun uzunlugu değişken

bunları pozıtıf olanlarını buyukten kucuge E VE F sütununa,

negatif olanları KÜÇÜKTEN BÜYÜĞE h ve ı sütunlarına yazdırmak istiyorum.

vba olarak yardımcı olabılırmısınız .


emeğinize sağlık

burhan.xlsx dosyasını indir - download

burhan.xlsx dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s7.dosya.tc

 

[Haluk]

Google Sheets ile kolayca yapılabilir;

E2 ve H2 hücrelerine yazılan formüller ilgili tabloyu hazırlar....

İşiniz bittikten sonra da MS Excel formatında dosyayı bilgisayara indirebilirsiniz.

Test_Filter_And_Sort

docs.google.com

.

 

[burhanyildirim11]

Google Sheets ile kolayca yapılabilir;

E2 ve H2 hücrelerine yazılan formüller ilgili tabloyu hazırlar....

İşiniz bittikten sonra da MS Excel formatında dosyayı bilgisayara indirebilirsiniz.

Test_Filter_And_Sort

docs.google.com

.

Haluk hocam

excel 2016 kullanıyorum . diğer kodlarımının içine ekleyeceğimden google sheet bana yaramaz

sanırım yazdıgınız formuller bende yok .tam bilmiyorum ama dediğiniz exceli indirdim ekran görünütüsü ekledim

vba olarak yazabılırmısınız

DOSYA_T.jpg dosyasını indir - download

DOSYA_T.jpg dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s6.dosya.tc

 

[YUSUF44]

Aşağıdaki makroyu deneyin:

Sub sayilar()
Range("E2:I" & Rows.Count).ClearContents

Set con = VBA.CreateObject("adodb.Connection")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=no"""

sorgu = "select * from [Sayfa1$A1:B" & son & "] where f2>0 order by F2 desc "
Set rs = con.Execute(sorgu)
[E2].CopyFromRecordset rs

sorgu = "select * from [Sayfa1$A1:B" & son & "] where f2<0 order by F2 asc "
Set rs = con.Execute(sorgu)
[H2].CopyFromRecordset rs
End Sub

 

[Haluk]

Yusuf Beyin kodunun biraz daha kısaltılmış şekli;

Sub Test()
    Dim objConn As Object
    
    Range("E2:H" & Rows.Count).ClearContents
    
    Set objConn = CreateObject("ADODB.Connection")
    objConn.Open "Provider=MICROSOFT.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties='Excel 12.0;HDR= No'"
    
    [E2].CopyFromRecordset objConn.Execute("Select F1, F2 From [Sayfa1$A1:B] Where F2>0")
    [H2].CopyFromRecordset objConn.Execute("Select F1, F2 From [Sayfa1$A1:B] Where F2<0")
    
    objConn.Close
    Set objConn = Nothing
End Sub

.

 

[burhanyildirim11]

Yusuf Beyin kodunun biraz daha kısaltılmış şekli;

Sub Test()
    Dim objConn As Object
   
    Range("E2:H" & Rows.Count).ClearContents
   
    Set objConn = CreateObject("ADODB.Connection")
    objConn.Open "Provider=MICROSOFT.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties='Excel 12.0;HDR= No'"
   
    [E2].CopyFromRecordset objConn.Execute("Select F1, F2 From [Sayfa1$A1:B] Where F2>0")
    [H2].CopyFromRecordset objConn.Execute("Select F1, F2 From [Sayfa1$A1:B] Where F2<0")
   
    objConn.Close
    Set objConn = Nothing
End Sub

.

Aşağıdaki makroyu deneyin:

Sub sayilar()
Range("E2:I" & Rows.Count).ClearContents

Set con = VBA.CreateObject("adodb.Connection")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=no"""

sorgu = "select * from [Sayfa1$A1:B" & son & "] where f2>0 order by F2 desc "
Set rs = con.Execute(sorgu)
[E2].CopyFromRecordset rs

sorgu = "select * from [Sayfa1$A1:B" & son & "] where f2<0 order by F2 asc "
Set rs = con.Execute(sorgu)
[H2].CopyFromRecordset rs
End Sub

teşekkür ederim , emeğinize sağlık ...