Listeden istediğimi tıklayıp farklı sayfadan çıktı alma ?

[M~a~T~R~a~X]

Arkadaşlar istediğim şeyi anlatmaya çalışıcam umarım yardımcı olan çıkar. Örneğin elimizde bir isim listesi var o listenin başlarında kutucuklar olsun istiyorum o kutucuklardan istediğimi seçebiliyim ve seçtiklerimde farklı bir sayfada liste şeklinde çıktı almak istiyorum bunu nasıl yapabilirim umarım anlatabilmişimdir.

 

[hamitcan]

Dosyanızı hazırlayın, yardımcı olacak arkadaşlar çıkacaktır.

 

[M~a~T~R~a~X]

?

dosyayı hazırladım arkadaşlar yardımcı olursanız çok sevinirim.dosya haricinde birde paint dosyasında ne istediklerimi anlattım umarım düzgün anlatabilmişimdir.

 

[Necdet]

Merhaba,

Konu üstünde çalışıyorum. Az birşeyler kaldı.

 

[Korhan Ayhan]

Selamlar,

Ekteki örnek dosyayı incelermisiniz. Dizi formülü ile hazırlanmıştır. Siz sadece listelemek istediğiniz verinin A sütununa X yazmanız gerekecektir.

 

[Necdet]

Merhaba,

Yine geç kaldım

Korhan Bey, fonksiyonla yapmış, bende makro ile üzerinde çalışmıştım.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
If Target.Row < 6 Then Exit Sub
For Each Hücre In Selection
    If Hücre = "" Then
        Hücre.Value = "ü"
    Else
        Hücre.Value = ""
    End If
Next Hücre
End Sub

Yukarıdaki kodlar "FİYAT" sayfasında A sütununda Seçtiğiniz Hücrelere çentik atar. Aynı hücreyi yine seçerseniz bu sefer seçimi kaldırır.

Arkadaşımız çıktıya hazır olsun deyince biraz olayı süsledim.

Sub Aktar()
Application.ScreenUpdating = False
Set sf = Sheets("FİYAT")
Set sl = Sheets("Liste")
Dim i, j, Adet As Long
j = 1
sl.Range("A2:D65536").Clear
For i = 6 To sf.[B65536].End(3).Row
    If sf.Cells(i, "A") <> "" Then
        Adet = Adet + 1
        j = j + 1
        sl.Cells(j, "A") = sf.Cells(i, "B")
        sl.Cells(j, "B") = sf.Cells(i, "C")
        sl.Cells(j, "C") = sf.Cells(i, "D")
        sl.Cells(j, "D") = sf.Cells(i, "E")
    End If
Next i
 
sl.Select
j = [A65536].End(3).Row
'If Application.LanguageSettings.LanguageID(msoLanguageIDUI) = 1033 Then
'    Formül = "=MOD(ROW();2)=0"
'Else
'    Formül = "=MOD(SATIR();2)=0)"
'End If
Range("A2:D" & j).Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
    "=MOD(SATIR();2)=1"
'        "=MOD(ROW();1)=0"
Selection.FormatConditions(1).Interior.ColorIndex = 15
MsgBox Adet & " Satır Aktarıldı......"
Application.ScreenUpdating = True
[E1].Select
sl.PrintPreview
'sl.PrintOut
End Sub

Sub Temizle()
Sheets("FİYAT").Columns(1).ClearContents
End Sub

Not : İngilizce versiyonda Koşullu Biçimlendirmeyi göremeyebilirsiniz.
Ben biraz üzerinde çalıştım her iki şartta da çalışması için ama başarılı olamadım. Bu konuda Uzman Arkadaşlardan Yardım bekliyorum.

 

[Levent Menteşoğlu]

Necdet bey aşağıdaki gibi deneyin.

.
.
If Application.LanguageSettings.LanguageID(msoLanguageIDUI) = 1055 Then
Formül = "=MOD(SATIR();2)=0"
Else
Formül = "=MOD(ROW(),2)=0"
End If
Range("A2:D" & j).Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:=Formül
Selection.FormatConditions(1).Interior.ColorIndex = 15
.
.

 

[Necdet]

Merhaba Levent Bey,

Yarın işyerinde deniyeceğim. Ben önce 1033 ten gitmiştim, Türkçe kullananlarda kod nasıl olsa 1055 olur düşüncesiyle ama kah çalıştı kah çalışmamıştı.

 

[M~a~T~R~a~X]

valla elleriniz dert görmesin çok sağolun ilgilendiğiniz için hepinizden Allah razı olsun

 

[Necdet]

Merhaba.

Maalesef İngilizce versiyonda Levent Bey'in önerisi çalışmadı. Hem 2003 hem 2007 de.

Run-time error '5':
Invalid procedure call or argument

hatası alıyorum.
Bu sorunu aşamadım gitti

 

[Necdet]

Merhaba,

Sanırım Koşullu Biçimlendirmede formül için değişkeni kabul etmiyor, bende aşağıdaki gibi durumu çözdüm (Bu sefer de işyerinde ingilizce sürüm var, umarım Türkçe sürümde bir sorun olmaz).

Sub Aktar()
Application.ScreenUpdating = False
Dim Formül As String
Set sf = Sheets("FİYAT")
Set sl = Sheets("Liste")
Dim i, j, Adet As Long
j = 1
sl.Range("A2:D65536").Clear
For i = 6 To sf.[B65536].End(3).Row
    If sf.Cells(i, "A") <> "" Then
        Adet = Adet + 1
        j = j + 1
        sl.Cells(j, "A") = sf.Cells(i, "B")
        sl.Cells(j, "B") = sf.Cells(i, "C")
        sl.Cells(j, "C") = sf.Cells(i, "D")
        sl.Cells(j, "D") = sf.Cells(i, "E")
    End If
Next i
sl.Select
j = [A65536].End(3).Row
Range("A2:D" & j).Select
Selection.FormatConditions.Delete
If Application.LanguageSettings.LanguageID(msoLanguageIDUI) = 1055 Then
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=MOD(SATIR();2)=1"
Else
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=MOD(ROW();2)=1"
End If
Selection.FormatConditions(1).Interior.ColorIndex = 15
MsgBox Adet & " Satır Aktarıldı......"
Application.ScreenUpdating = True
[E1].Select
sl.PrintPreview
'sl.PrintOut
End Sub

 

[kamenzü]

Selamlar,

Ekteki örnek dosyayı incelermisiniz. Dizi formülü ile hazırlanmıştır. Siz sadece listelemek istediğiniz verinin A sütununa X yazmanız gerekecektir.

Merhaba,

Konuyu hortlatmış diye düşünmeyin lütfen.

Alıntı yaptığım sayın Korhan Ayhan'a ait yazıdaki eki indiremedim ve üzerinde çalışamadım.

Benim de formül ile yazdırma yapabileceğim bir tabloya ihtiyacım var.

Örnek;
A sütununa Sayfa linki,
B sütununa kaç sayfa yazdırılacağı,
olursa çok mükemmel olur,