dongü

[prodigy]

Sub bul()
Cells.Find(What:="sıra", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate

'*************************************************

Cells.Find(What:="toplam", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
Range(Selection.Cells, Selection.End(xlDown)).Select

'*************************************************
Set LeftCell = Cells(ActiveCell.Row, 3)
Set RightCell = Cells(ActiveCell.Row, 256)
If IsEmpty(LeftCell) Then Set LeftCell = LeftCell.End(xlToRight)
If IsEmpty(RightCell) Then Set RightCell = RightCell.End(xlToLeft)
If LeftCell.Column = 256 And RightCell.Column = 1 Then ActiveCell.Select Else Range(LeftCell, RightCell).Select
Range(Selection.Cells, Selection.End(xlDown)).Select
End Sub
burada iki sorum olacak :
1- yukarıdaki makroda sıra ve toplamı bulan makroyu daha kısa nasıl yazabiliriz.
2- bu makroyla sayfa1 deki ilk satırdaki sıra ve toplam hücresini bulup ilgili alanı seçiyor. daha sonra makroyu çalıştırdığımda 2. ci sıra ve toplam hücrelerini bulup seçiyor..........
burada sayfa 1 de kaç tane sıra ve toplam hücresi var ise bir döngü kullanrak otomotik yapmasını istiyorum.
saygılarımla

 

[Archi]

Aşağıdaki ADET_SAY fonksiyonu ile istediğiniz sayfada istediğiniz kelimenin adedini saydırabilirsiniz.

Sub Deneme()
toplamKelimeAdedi = Adet_Say("toplam", ThisWorkbook.Worksheets("Sayfa1"))
MsgBox toplamKelimeAdedi
End Sub



Function Adet_Say(ByVal KELIME As String, ByVal S1 As Worksheet) As Integer

Dim ilkAdres As Range
Dim yeniAdres As Range

Set ilkAdres = S1.Cells.Find(KELIME, S1.Range("A1"), xlFormulas, xlPart, xlByRows, xlNext, False, False)
If ilkAdres Is Nothing Then
Adet_Say = 0
Else
Adet_Say = 1
Set yeniAdres = ilkAdres
tekrar:

Set yeniAdres = S1.UsedRange.Find(KELIME, yeniAdres, xlValues, xlPart, xlByRows, xlNext, False, False)
If yeniAdres.Address = ilkAdres.Address Then
Exit Function
Else
Adet_Say = Adet_Say + 1
GoTo tekrar:
End If
End If
End Function

 

[prodigy]

çok teşekkür ederim. tam istediğim gibi.