• DİKKAT

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

Düşeyara

A

arifnihat

Katılım
23 Eylül 2010
Mesajlar
5
Excel Vers. ve Dili
2007
Merhaba arkadaşlar. aranıza yeni katıldım. sanırım çözümünü düşeyara ile bulacağınız bir sorunum var. ekte de göreceğiniz gibi sayfadaki belirli bir sütunda verisi bulunan satırları diğer sayfaya çekmem gerekiyor. yardımlarınız için teşekkürler.

Not: örnek dosyasında detaylı açıklama mevcut.
 

Ekli dosyalar

örnek dosyaya bakarmnısınız orda acıklama var. daha acıklayıcı olur
 
dosyanızdan anlamadım hangi sayfada formüller ile bu işlem yapılacak anlatırsanız
 
verileri sbt sayfasından cekecegiz. sbt_içtima sayfası sbt sayfasındaki verilerin sıralanmıs halı olacak aslında.
per.dur.rap sayfasında ise, sbt sayfasının f sütununda bilgi olan satırlarının bir listesi olacak. çok şey istedim galiba :S :???:
 
aşağıdaki kodu bir nodüle kopyalayarak bir düğmeye atayabilirsiniz.

not: sort etme ve border işlemleri için doğrudan makro kaydedicinin kodları alınmıştır.

Kod: 
Sub ictima()

Sheets("sbt").Range("A3:f160").Copy Destination:=Sheets("sbt_içtima").Range("A2")

ActiveWorkbook.Worksheets("sbt_içtima").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("sbt_içtima").Sort.SortFields.Add Key:=Range( _
    "F2:F160"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
    xlSortNormal
ActiveWorkbook.Worksheets("sbt_içtima").Sort.SortFields.Add Key:=Range( _
    "E2:E160"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
    xlSortNormal
ActiveWorkbook.Worksheets("sbt_içtima").Sort.SortFields.Add Key:=Range( _
    "D2:D160"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
With ActiveWorkbook.Worksheets("sbt_içtima").Sort
    .SetRange Range("b1:F160")
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
Range("A2").Select

Dim sonsat As Integer

sonsat = Sheets("sbt_içtima").Range("F65536").End(3).Row

For i = 2 To sonsat
Sheets("Per.Durum.Rap").Range("A" & i + 2) = Sheets("sbt_içtima").Range("A" & i)
Sheets("Per.Durum.Rap").Range("B" & i + 2) = Sheets("sbt_içtima").Range("C" & i)
Sheets("Per.Durum.Rap").Range("C" & i + 2) = Sheets("sbt_içtima").Range("B" & i)
Sheets("Per.Durum.Rap").Range("D" & i + 2) = Sheets("sbt_içtima").Range("D" & i)
Sheets("Per.Durum.Rap").Range("E" & i + 2) = Sheets("sbt_içtima").Range("F" & i)
Next

Sheets("Per.Durum.Rap").Select
    Range("A3").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("A3").Select

End Sub
 
çok makbüle geçti. bir kaç değişiklik ile işime yaradı. teşekkür ederim
 
tekrar rahatsız ediyorum...
problemi office 2007de çözmüştük. ama 2003te bu makroyu çalıştırmaya kalktığımda:

"Runtime error-438
object doesnt support this property or method"

hatası vererek şu satıra işaret ediyor

"ActiveWorkbook.Worksheets("sbt_içtima").Sort.SortFields.Clear"

araştırdım ama çözemedim...
 
2003 için de aşağıdakini deneyin

Kod: 
Sub ictima_xl2003()

Sheets("sbt").Range("A3:f160").Copy Destination:=Sheets("sbt_içtima").Range("A2")

Sheets("sbt_içtima").Select

Range("B2:F160").Sort Key1:=Range("F2"), Order1:=xlAscending, Key2:=Range( _
        "E2"), Order2:=xlAscending, Key3:=Range("D2"), Order3:=xlAscending, _
        Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:= _
        xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, _
        DataOption3:=xlSortNormal
        
Range("A2").Select

Dim sonsat As Integer

sonsat = Sheets("sbt_içtima").Range("F65536").End(3).Row

For i = 2 To sonsat
Sheets("Per.Durum.Rap").Range("A" & i + 2) = Sheets("sbt_içtima").Range("A" & i)
Sheets("Per.Durum.Rap").Range("B" & i + 2) = Sheets("sbt_içtima").Range("C" & i)
Sheets("Per.Durum.Rap").Range("C" & i + 2) = Sheets("sbt_içtima").Range("B" & i)
Sheets("Per.Durum.Rap").Range("D" & i + 2) = Sheets("sbt_içtima").Range("D" & i)
Sheets("Per.Durum.Rap").Range("E" & i + 2) = Sheets("sbt_içtima").Range("F" & i)
Next

Sheets("Per.Durum.Rap").Select
Range("A3").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Borders.LineStyle = xlNone
With Selection.Borders
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
End With
Range("A3").Select

End Sub
 
yaptığım tek şey xl2003'te makro kaydedicisini çalıştırarak hata veren yerleri manuel yapıp kaydetmek oldu. çok gerekli olmayan satırları silerek makroyu biraz sadeleştirdim. aralıkları düzenledim o kadar.

yedek bir dosya üzerinde makro kaydedicisini kullanmaktan çekinmeyin.
 
Öncelikle herkese merhaba,

Foruma daha bugün üye oldum ve çok yeniyim. Bir çok konuyu okudum, birçok şey öğrendim öncelikle herşey için teşekkür ederim. Ancak çözümünü bulamadığım birşeyi size danışmak istiyorum. Ekte eklediğim dosyada, A2 sayfası güncel stoklarımın Mikro Muhasebe programından excele aktarılmış hali, A1 sayfası ise güncel stoklarımı tuttuğum dosya.

Benim yapmak istediğim şey :

A2 sayfası A sütununda belirtilen kod numaralarının, A1 sayfasında A sütununda eşleştiği kod numaralarının R sütununa işlenmesi.

Örneğin A2 sayfasında, A79'da belirtilen ürün 1.200 ise, A1 sayfası R14'e 1.200 olarak geçmesidir.

Şimdiden yardımlarınız için çok teşekkür ederim.
 

Ekli dosyalar

Selamlar,

R4 Hücresine aşagıdaki formülü yapıştırın bakalım istediğiniz gibi olacakmı .

Kod: 
=EĞER(EHATALIYSA(DÜŞEYARA("*"&A4&"*";'A2'!$A:$C;3;0));0;DÜŞEYARA("*"&A4&"*";'A2'!$A:$C;3;0))
 
Vedat Özer' Alıntı:
Selamlar,

R4 Hücresine aşagıdaki formülü yapıştırın bakalım istediğiniz gibi olacakmı .

Kod: 
=EĞER(EHATALIYSA(DÜŞEYARA("*"&A4&"*";'A2'!$A:$C;3;0));0;DÜŞEYARA("*"&A4&"*";'A2'!$A:$C;3;0))
Genişletmek için tıkla ...

Oldu, çok teşekkür ederim. Formülü açıklayabilir misiniz? Başka yerlere de uygulayabilmek için sizi bir daha rahatsız etmek durumunda kalmam.
 
Selamlar,

Eğer formülünü mantıksal bir kavramdan geçirmek için kulandım nedeni ise düşeyara "#yok" hatasını vermesini engellemek için bunuda yardımcı fonksiyon olan e hatalıysa ile yaptım.

Düşeyara'da "*"&a4&"*" yazmanın nedeni sizin diğer sayfa sekmesinde sayıların metin olarak gözükmesidir.Aslında metin olarak gözüken rakamlar sayı olsa "*"&a4&"*" gerek kalmaz.

Düşeyara birincisi 2 Adet Parantezle kapattım nedeni mantıksal sınamadan geçtikten sonra doğruysa ne olacagı dır.

Burda "0" Koydum nedeni ise eğer bu sonuç bir şey gözükmezse 0 olur boş gözükmesi için "0" yerini "" ekleyebiliriz.

Eğer "#yok" hatası yoksa yani eğer göre gittiğimizde yanlış değeri varsa tekrardan ayın şekilde düşeyara formülünü kulandım.


Umarım anlaşılmıştır.



İyi Çalışmalar Dilerim.
 
Vedat Özer' Alıntı:
Selamlar,

Eğer formülünü mantıksal bir kavramdan geçirmek için kulandım nedeni ise düşeyara "#yok" hatasını vermesini engellemek için bunuda yardımcı fonksiyon olan e hatalıysa ile yaptım.

Düşeyara'da "*"&a4&"*" yazmanın nedeni sizin diğer sayfa sekmesinde sayıların metin olarak gözükmesidir.Aslında metin olarak gözüken rakamlar sayı olsa "*"&a4&"*" gerek kalmaz.

Düşeyara birincisi 2 Adet Parantezle kapattım nedeni mantıksal sınamadan geçtikten sonra doğruysa ne olacagı dır.

Burda "0" Koydum nedeni ise eğer bu sonuç bir şey gözükmezse 0 olur boş gözükmesi için "0" yerini "" ekleyebiliriz.

Eğer "#yok" hatası yoksa yani eğer göre gittiğimizde yanlış değeri varsa tekrardan ayın şekilde düşeyara formülünü kulandım.


Umarım anlaşılmıştır.



İyi Çalışmalar Dilerim.
Genişletmek için tıkla ...

Tekrar çok teşekkür ederim.

İyi çalışmalar
 
Selamun Aleyküm,

İyi çalışmalar dilerim.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst