با سلام
کد زیر رو ملاحظه کنید.به نظرم علی رغم پیچیده مطرح شدن، ساده بود.
کد:
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
برای نمایش پیغام هم از کد زیر استفاده کنید.ضمنا"سل G29 رو از حالا merge خارج کنید.
این کد در صورت منفی شدن به رنگ قرمز و با کلیک کردن بر روی سل ،پیغام نمایش میدهد.
کد:
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
علاقه مندی ها (Bookmarks)