جستجو و جایگزینی

[razemana]

با سلام و وقت بخیر ، یه مشکلی برام پیش اومده تو فایل اکسل پیوست ممنون میشم دوستان راهنمایی بفرمایند ،توضیحاتشو دادم تو فایل ،تشکر

[amir_ts]

با سلام
کد زیر رو ملاحظه کنید.به نظرم علی رغم پیچیده مطرح شدن، ساده بود.

[LEFT]Sub test()
Dim i As Integer
Dim ran1 As Range
Dim t, s As Variant
On Error Resume Next
Set ran1 = Sheets("ÒÇÑÔ 1").Range("E13:E24")
           For i = 13 To 25
                 t = Application.Match(Cells(i, 10), ran1, 0)
                 s = Application.Match(Cells(i, 11), ran1, 0)


            If Not IsError(t) Then
            Sheets("ÒÇÑÔ 1").Range("i" & t + 12) = Sheets("ÒÇÑÔ 1").Range("i" & t + 12).Value + Cells(i, 9).Value
            End If
 
            If Not IsError(s) Then
            Sheets("ÒÇÑÔ 1").Range("h" & s + 12) = Sheets("ÒÇÑÔ 1").Range("h" & s + 12).Value + Cells(i, 9).Value
            End If
 
  Next


End Sub


[/LEFT]

برای نمایش پیغام هم از کد زیر استفاده کنید.ضمنا"سل G29 رو از حالا merge خارج کنید.
این کد در صورت منفی شدن به رنگ قرمز و با کلیک کردن بر روی سل ،پیغام نمایش میدهد.

[LEFT]

Private Sub Worksheet_SelectionChange(ByVal target As Range)
If Not Intersect(target, Me.Range("G29")) Is Nothing Then
If target.Value < 0 Then
target.Interior.ColorIndex = 3
MsgBox "Èå ãíÒÇä" & " " & target.Value & " " & ".˜ÓÑí ÈæÏÌå ÏÇÑíÏ"
Else: target.Interior.ColorIndex = 0
End If
End If
End Sub


[/LEFT]

[razemana]

با سلام و وقت بخیر ،خیلی ممنون از راهنماییتون واقعا عالی بود فقط چند تا مورد اگه حل بشه خیلی عالی میشه ،تو فایل اکسل پیوست توضیح دادم .تشکر

[amir_ts]

با سلام و وقت بخیر ،خیلی ممنون از راهنماییتون واقعا عالی بود فقط چند تا مورد اگه حل بشه خیلی عالی میشه ،تو فایل اکسل پیوست توضیح دادم .تشکر

با سلام
جواب سوالات در فایل شماره 1 توضیح داده شد.