Merhaba arkadaşlar userform aracılığı ile veri girişi yapıyorum excel sayfasındaki tabloya veriler aktarılıyor yanımda çalışan işçiler var ve ben bunlara ay içinde avanslar veriyorum exceldeki sayfama bir bul butonu yaptım kime avans vermişsem tektek buluyor ama o kişinin ay içinde toplam kaç lira avans aldığını aynı düğme ile yapmak istiyorum yardımcı olursanız teşekkür ederim kulandığım kodlar şöyle
ARA BUL KODU
Sub FindData2()
On Error Resume Next
Dim wsSheet As Worksheet
Dim rFound As Range
Dim MyData As Variant
MyData = InputBox("NO VEYA ARANILAN KELÝMEYÝ YAZINIZ.")
If MyData = False Or MyData = "" Then End
For Each wsSheet In ActiveWorkbook.Worksheets
Set rFound = wsSheet.UsedRange. _
Find(What:=CStr(MyData), LookIn:=xlValues, _
LookAt:=xlPart, MatchCase:=False)
If Not rFound Is Nothing Then
bln = bln + 1
First = rFound.Address
Do
Application.Goto rFound
ActiveCell.EntireRow.Select
Selection.Interior.ColorIndex = 6
ActiveCell.Select
Selection.Interior.ColorIndex = 4
ActiveCell.Select
s = " ARANAN KÝÞÝNÝN." & " " & " / " & "ALDIÐI HARÇLIK VEYA AVANS" & " " & ActiveCell.Offset(0, 3).Value & " " & "YTL" & "" & " TARÝH " & ActiveCell.Offset(0, 9).Value
sor = MsgBox(s, vbYesNo)
If sor = vbNo Then Exit Sub
'MsgBox " ALDIÐI HARÇLIK VEYA AVANS" & " " & ActiveCell.Offset(0, 4).Value & " " & "YTL" & " " & " TARÝH " & ActiveCell.Offset(0, 10).Value
'If MsgBox("Aramaya devam edilsin mi?", vbInformation + vbYesNo, "Arama Formu ") = vbNo Then End
Set rFound = wsSheet.UsedRange.FindNext(rFound)
Loop While Not rFound Is Nothing And rFound.Address <> First
End If
Next wsSheet
'MsgBox s
If bln = 0 Then: MsgBox "Aradýðýnýz veri bulunamadý, !", vbExclamation, "Arama Sonucu "
End Sub
ARA BUL KODU
Sub FindData2()
On Error Resume Next
Dim wsSheet As Worksheet
Dim rFound As Range
Dim MyData As Variant
MyData = InputBox("NO VEYA ARANILAN KELÝMEYÝ YAZINIZ.")
If MyData = False Or MyData = "" Then End
For Each wsSheet In ActiveWorkbook.Worksheets
Set rFound = wsSheet.UsedRange. _
Find(What:=CStr(MyData), LookIn:=xlValues, _
LookAt:=xlPart, MatchCase:=False)
If Not rFound Is Nothing Then
bln = bln + 1
First = rFound.Address
Do
Application.Goto rFound
ActiveCell.EntireRow.Select
Selection.Interior.ColorIndex = 6
ActiveCell.Select
Selection.Interior.ColorIndex = 4
ActiveCell.Select
s = " ARANAN KÝÞÝNÝN." & " " & " / " & "ALDIÐI HARÇLIK VEYA AVANS" & " " & ActiveCell.Offset(0, 3).Value & " " & "YTL" & "" & " TARÝH " & ActiveCell.Offset(0, 9).Value
sor = MsgBox(s, vbYesNo)
If sor = vbNo Then Exit Sub
'MsgBox " ALDIÐI HARÇLIK VEYA AVANS" & " " & ActiveCell.Offset(0, 4).Value & " " & "YTL" & " " & " TARÝH " & ActiveCell.Offset(0, 10).Value
'If MsgBox("Aramaya devam edilsin mi?", vbInformation + vbYesNo, "Arama Formu ") = vbNo Then End
Set rFound = wsSheet.UsedRange.FindNext(rFound)
Loop While Not rFound Is Nothing And rFound.Address <> First
End If
Next wsSheet
'MsgBox s
If bln = 0 Then: MsgBox "Aradýðýnýz veri bulunamadý, !", vbExclamation, "Arama Sonucu "
End Sub