belli bir aralıkta arama yaptıktan sonra sonuçları yazdırma veya sonuçların içerisinden tekrar arama yapabilme tşkler
Ekli dosyalar
-
17.5 KB Görüntüleme: 8
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
=DOLAYLI("a"&TOPLA.ÇARPIM((ESAYIYSA(BUL("a";A1:A10;1)))*(ESAYIYSA(BUL("b";A1:A10;1)))*(ESAYIYSA(BUL("n";A1:A10;1)))*(ESAYIYSA(BUL("h";A1:A10;1)))*SATIR(A1:A10)))
Sub ara_59()
Dim sat As Long, ara, i As Byte, sat2 As Long
Sheets("Sayfa1").Select
ara = Array("", "", "a", "b", "n", "h")
Application.ScreenUpdating = False
Range("B1:F65536").ClearContents
For i = 2 To 5
sat = 1
sat2 = Cells(65536, i - 1).End(xlUp).Row
For j = 1 To sat2
If WorksheetFunction.CountIf(Range(Cells(j, i - 1), Cells(j, i - 1)), "*" & ara(i) & "*") > 0 Then
'MsgBox WorksheetFunction.CountIf(Range(Cells(1, i - 1), Cells(1, i - 1)), "*" & ara(i) & "*")
Cells(sat, i).Value = Cells(j, i - 1).Value
sat = sat + 1
End If
Next j
Next i
Application.ScreenUpdating = True
MsgBox "İşlem tamamdır.", vbOKOnly + vbInformation, Application.UserName
End Sub
merhabaörneğe göre çalışıyor ama benim istediğim arayacağım karakterlerin sırasını değiştirmemin sonucu etkilememesi. Yani sizin formülde aranacak karakterleri hücrelere yönlerdim; mesela "a"=k1 "b"=k2 "n"=k3 "h"=k4 . k1=h k4=a olsa da aynı sonucu bulabilmem. yine de çabaların için tşkler
merhabatşk ederim ama siz denemeden yorum yapıyorsunuz ben sabit değer lerden bahsetmiyorum aranacak sabitleri birer hücreye yönlendirdiğinizde
"=DOLAYLI(A15&TOPLA.ÇARPIM((ESAYIYSA(BUL(A15;A1:A10;1)))*(ESAYIYSA(BUL(A16;A1:A10;1)))*(ESAYIYSA(BUL(A17;A1:A10;1)))*(ESAYIYSA(BUL(A18;A1:A10;1)))*SATIR(A1:A10)))"
gibi aranacak değerlerin sırası sonucu etkiliyor.
"=DOLAYLI([COLOR="Red"][B]A15[/B][/COLOR]&TOPLA.ÇARPIM((ESAYIYSA(BUL(A15;A1:A10;1)))*(ESAYIYSA(BUL(A16;A1:A10;1)))*(ESAYIYSA(BUL(A17;A1:A10;1)))*(ESAYIYSA(BUL(A18;A1:A10;1)))*SATIR(A1:A10)))"
=DOLAYLI("A"&TOPLA.ÇARPIM((ESAYIYSA(BUL(A15;$A$1:$A$10;1)))*(ESAYIYSA(BUL(A16;$A$1:$A$10;1)))*(ESAYIYSA(BUL(A17;$A$1:$A$10;1)))*(ESAYIYSA(BUL(A18;$A$1:$A$10;1)))*SATIR($A$1:$A$10)))
Private Sub CommandButton2_Click()
Dim sat As Long, ara, i As Byte, sat2 As Long
Sheets("Sayfa1").Select
'ara = Array("", "", "a", "b", "n", "h")
If ListBox1.ListCount < 1 Then Exit Sub
Application.ScreenUpdating = False
Range("B1:IV65536").ClearContents
For i = 2 To ListBox1.ListCount + 1
sat = 1
sat2 = Cells(65536, i - 1).End(xlUp).Row
For j = 1 To sat2
If WorksheetFunction.CountIf(Range(Cells(j, i - 1), Cells(j, i - 1)), "*" & ListBox1.List(i - 2, 0) & "*") > 0 Then
'MsgBox WorksheetFunction.CountIf(Range(Cells(1, i - 1), Cells(1, i - 1)), "*" & ara(i) & "*")
Cells(sat, i).Value = Cells(j, i - 1).Value
sat = sat + 1
End If
Next j
Next i
Application.ScreenUpdating = True
MsgBox "İşlem tamamdır.", vbOKOnly + vbInformation, Application.UserName
ListBox1.Clear
End Sub
Peki bizim çabalarımız sizin istediğinizi verdimi.Oldumu?tşk ederim çabalarınız için iyi geceler