[حل شده] راهنمايي و ارائه در مورد دو كد ماكرو

[مائده]

سلام به استادان گرامي
من دو تا كد از عزيزان ميخواستم:
يكي وقتي كه در ستون f با يكسري تغييرات انجام شده در ماكرو عدد منفي شد اون سل يا عدد رنگي بشه
...
كد دوم هم عدد هايي كه در ستون e هست از f كسر كنه و در ستون g* بنويسه و كمتر از عدد صفر را همان صفر نمايش بده يعني عدد با علامت منفي نياره.!
ممنون ميشم كد ها را بفرمايين اساتيد

[amir_ts]

با سلام
این کد ها رو فعلا تا اساتید بخش مربوطه پاسخ میدن ببینید.
برای نمایش بهتر 20 ردیف در نظر گرفتم که متناسب با نیازتون داخل کد میتونید کم و یا زیاد کنید.

[LEFT]
 Sub test()

Dim i As Integer
            For i = 1 To 20
                 Sheet1.Range("g" & i).Value = Sheet1.Range("e" & i).Value - Sheet1.Range("f" & i).Value
                     If Sheet1.Range("g" & i).Value <= 0 Then
                     
                     Sheet1.Range("e" & i).Interior.ColorIndex = 7
                      Sheet1.Range("f" & i).Interior.ColorIndex = 7
                      Sheet1.Range("g" & i).Value = 0
                      
                      End If
             Next i
End Sub
[/LEFT]

[amir_ts]

با اضافه کردن این کد دیگه احتیاح به شماره ردیف دادن نیست و به صورت پویا تا آخرین ردیف ستون e پردازش انجام میشه.

endrow = Sheet1.Range("e999999").End(xlUp).Row 

[LEFT]
Dim i As Integer
Dim endrow As Long

endrow = Sheet1.Range("e999999").End(xlUp).Row
            For i = 1 To endrow
                 Sheet1.Range("g" & i).Value = Sheet1.Range("e" & i).Value - Sheet1.Range("f" & i).Value
                     If Sheet1.Range("g" & i).Value <= 0 Then
                     
                     Sheet1.Range("e" & i).Interior.ColorIndex = 7
                      Sheet1.Range("f" & i).Interior.ColorIndex = 7
                      Sheet1.Range("g" & i).Value = 0
                      
                      End If
             Next i
End Sub
[/LEFT]

[مائده]

با سلام
تشكر فراوان از شما استاد گرامي
برنامه اي كه زحمت كشيدين در يه شيت قابل اجرا هست ولي تعداد شيت هاي من در فايلم بي نهايت !
و چطور ميشه اين عمليات به صورت خودكار انجام بشه بدون اجرا كردن از كامند بوتون
ممنون ميشم پاسخ بدهيد

[amir_ts]

با سلام
این کد رو تو قسمت کد نویسی تو رویداد open از Workbook مورد نظر بنویسید.

Private Sub Workbook_Open()
Dim i As Integer
Dim endrow As Long
Dim current As Worksheet


For Each current In Worksheets


endrow = current.Range("e999999").End(xlUp).Row
            For i = 1 To endrow
                     current.Range("g" & i).Value = current.Range("e" & i).Value - current.Range("f" & i).Value
                     If current.Range("g" & i).Value <= 0 Then
                     
                      current.Range("e" & i).Interior.ColorIndex = 7
                      current.Range("f" & i).Interior.ColorIndex = 7
                      current.Range("g" & i).Value = 0
                      
                      End If
             
             Next i
             Next current
           
End Sub

[مائده]

سلام
با تشكر از شما استاد گرامي
برنامه به درستي انجام ميشود.