Tüm sayfaları tek sayfada toplamak, ve arama yapmak

[mozdem]

Benim 2 sorum olacak

1-Gödermiş olduğum ekteki dosyanın tüm sayfalarındaki verileri Rapor sayfasında toplamak istiyorum. Bu işlemi formül ile yapmak istemiyorum. Çünkü dosya boyutunun yükselmesini istemiyorum

2- İstediğim sayısal yada metin verisinin hangi sayfada hangi satır ve sütunda olduğunu nasıl bulabilirim. (Bu birinci soru ile tamamen ayrı)

Teşekkür ederim.

 

[halit3]

Benim 2 sorum olacak

1-Gödermiş olduğum ekteki dosyanın tüm sayfalarındaki verileri Rapor sayfasında toplamak istiyorum. Bu işlemi formül ile yapmak istemiyorum. Çünkü dosya boyutunun yükselmesini istemiyorum

2- İstediğim sayısal yada metin verisinin hangi sayfada hangi satır ve sütunda olduğunu nasıl bulabilirim. (Bu birinci soru ile tamamen ayrı)

Teşekkür ederim.

2. surunla ilgili arama yapacağın dosyanın içine yeni bir sayfa aç aşağıdaki kodu bir dene

Sub bul()
ad = InputBox("aranacak değeri yazınız.", "DEĞER", "")
If ad = "" Then
MsgBox "İşlemi iptal ettiniz"
Exit Sub
End If
sut = 2
Worksheets(ActiveSheet.Name).Columns("A:E").ClearContents
Worksheets(ActiveSheet.Name).Cells(1, 1).Value = "Sayfa Adı"
Worksheets(ActiveSheet.Name).Cells(1, 2).Value = "Hücre adresi"
Worksheets(ActiveSheet.Name).Cells(1, 3).Value = "Satır No"
Worksheets(ActiveSheet.Name).Cells(1, 4).Value = "Sutun NO"
Worksheets(ActiveSheet.Name).Cells(1, 5).Value = "Bulunan Değer"
Worksheets(ActiveSheet.Name).Cells(1, 6).Value = "Aranan Değer " & ad
For r = 1 To ActiveWorkbook.Sheets.Count
If ActiveSheet.Name <> Sheets(r).Name Then
deger = Sheets(r).Name
Set d = Worksheets(deger).Cells.Find(ad, LookIn:=xlValues)
If Not d Is Nothing Then
firstAddress = d.Address
Do
'd.Interior.ColorIndex = 3 'buradaki sayı renkleri göstermektedir.
Worksheets(ActiveSheet.Name).Cells(sut, 1).Value = Sheets(r).Name
Worksheets(ActiveSheet.Name).Cells(sut, 2).Value = d.Address
Worksheets(ActiveSheet.Name).Cells(sut, 3).Value = d.Row
Worksheets(ActiveSheet.Name).Cells(sut, 4).Value = d.Column
Worksheets(ActiveSheet.Name).Cells(sut, 5).Value = d.Value
sut = sut + 1
Set d = Worksheets(deger).Cells.FindNext(d)
Loop While Not d Is Nothing And d.Address <> firstAddress
End If
End If
Next r
MsgBox sut - 2 & " adet bulundu"
End Sub

 

[mozdem]

Halit Hocam

Tam istediğim gibi, Çok teşekkür ederim. Ellerinize sağlık.

 

[halit3]

örnek dosya ekliyorum satır sutunuda buluyor