[µo°Ý] ¥N½X­×¥¿

wayne0303

Private Sub Worksheet_Change(ByVal Target As Range)
Dim xA As Range, xR As Range
Application.ScreenUpdating = False
Set xA = Intersect(Target, Range("U:U"))
If xA Is Nothing Then GoTo xA0
For Each xR In xA
    Range(Cells(xR.Row, 1), Cells(xR.Row, 22)).Font.ColorIndex = 15 ^ -(xR > 1)
Next

xA0:
Set xA = Intersect(Target, Range("O:O"))
If xA Is Nothing Then GoTo xA1
For Each xR In xA
    Range(Cells(xR.Row, 16), xR).Font.ColorIndex = 2 ^ -(xR = "")
Next

xA1:
Set xA = Intersect(Target, Range("J:J"))
If xA Is Nothing Then GoTo xA2
For Each xR In xA
    Range(Cells(xR.Row, 10), xR).Font.Color = RGB(0, 176, 240) ^ -(xR = "L")
    Range(Cells(xR.Row, 10), xR).Font.Bold = (xR = "L")
Next

xA2:
Set xA = Intersect(Target, Range("v:v"))
If xA Is Nothing Then GoTo xA3
For Each xR In xA
    Range(Cells(xR.Row, 1), xR).Font.Color = RGB(153, 102, 0) ^ -((xR Like "*©î¹Ï"))
Next


xA3:
Set xA = Intersect(Target, Range("p:p"))
If xA Is Nothing Then GoTo xA4
For Each xR In xA
    Range(Cells(xR.Row, 1), Cells(xR.Row, 22)).Font.ColorIndex = 5 ^ -(xR.Font.Strikethrough = True)
Next


xA4:
Set xA = Intersect(Target, Range("E:E"))
If xA Is Nothing Then Exit Sub

Dim st As String
Dim cell As Range

For Each cell In Me.Range("E2:E" & Me.Cells(Me.Rows.Count, "E").End(3).Row)
    st = IIf(cell.Value = "", "", _
                IIf(cell.Offset(0, -1).Value > 0, "LOB", _
                    IIf(Application.WorksheetFunction.CountIf(cell, "S1A*") > 0, "TM", "MU")))
    cell.Offset(0, -3).Value = st
   
Next

End Sub

½Ð¤j¤j­ÌÀ°§Ú­×¥¿¤@¤UÂŦⳡ¤Àªº¥N½X¬Ý«ç»ò¼g¤ñ¸û¶¶¡AÁÂÁÂ

Andy2483

¦^´_ 10# wayne0303


¥i¯à¬O³sÄòIJµo,¥i¥H¥Î¥H¤U¤è¦¡¸Õ¸Õ¬Ý
Application.EnableEvents = False
'·|²£¥Í³sÄòIJµoªº¦ì¸m,¨Ò¦p cell.Offset(0, -3).Value = st
Application.EnableEvents = True
IJµo¦¸¼Æ:

¤U¸ü (29.91 KB)

2024-1-17 10:21

¥H¤U¬O´ú¸ÕIJµo¦¸¼Æªº¥N½X
Option Explicit
Dim N&
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xR As Range, st$, cell As Range
With Target
   If .Column = 21 Then
      For Each xR In .Cells
         Cells(xR.Row, 1).Resize(, 22).Font.ColorIndex = 15 ^ -(Val(xR) > 1)
      Next
   End If
   If .Column = 15 Then
      For Each xR In .Cells
         Cells(xR.Row, 16).Font.ColorIndex = 2 ^ -(Trim(xR) = "")
      Next
   End If
   If .Column = 10 Then
      For Each xR In .Cells
         Cells(xR.Row, 10).Font.Color = RGB(0, 176, 240) ^ -(Trim(xR) = "L")
         Cells(xR.Row, 10).Font.Bold = (Trim(xR) = "L")
      Next
   End If
   If .Column = 22 Then
      For Each xR In .Cells
         Cells(xR.Row, 1).Resize(, 22).Font.Color = RGB(153, 102, 0) ^ -((xR Like "*©î¹Ï"))
      Next
   End If
   If .Column = 16 Then
      For Each xR In .Cells
         Cells(xR.Row, 1).Resize(, 22).Font.ColorIndex = 5 ^ -(xR.Font.Strikethrough = True)
      Next
   End If
   N = N + 1
If .Column <> 5 Then Exit Sub
   For Each cell In Union(Range([e2], [e65536].End(3)), .Cells)
      st = IIf(Trim(cell) = "", "", IIf(Val(cell.Offset(0, -1)) > 1, "LOB", _
                    IIf(Application.WorksheetFunction.CountIf(cell, "S1A*") > 0, "TM", "MU")))
      cell.Offset(0, -3).Value = st
      N = N + 1
      cell.Offset(0, 3).Resize(, 2) = IIf(cell <> "", 2, "")
      N = N + 1
   Next
End With
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim MUCount&, TMCount&, cellValue, Arr, i&
Arr = Range([B2], [B65536].End(3)).Value
If IsArray(Arr) Then
   MUCount = 0: TMCount = 0
   For i = 1 To UBound(Arr, 1)
      cellValue = Arr(i, 1)
      If Not Cells(i + 1, "P").Font.Strikethrough Then
         If cellValue = "MU" Then
            MUCount = MUCount + 1
            ElseIf cellValue = "TM" Then
               TMCount = TMCount + 1
         End If
      End If
   Next
[A1] = "®×¥ó " & MUCount & "¡þ" & TMCount
N = N + 1
MsgBox "¦X­pIJµo: " & N & " ¦¸"
End If
End Sub

wayne0303

¦^´_ 9# Andy2483


¦pªþ¥ó¡A¦A³Â·ÐAndy¤j¬d¬Ý¤@¤U
ÁÙ¦³A1¦X¨ÖÀx¦s®æªº®×¥ó²Î­p¤]·|¦³©µ¿ðªºª¬ªp

ÁÂÁÂ

Andy2483

¦^´_ 8# wayne0303


    §Ú´ú¸Õ¨S°ÝÃD,¦AÀˬd¤@¤U©Î§ó©ú½T»¡©ú/¹Ï¸Ñ/¤W¶Ç½d¨Ò

wayne0303

¦^´_ 7# Andy2483



·PÁÂAndy¤j~
·Q¦A½Ð°Ý¤@¤U¡A§Ú¥[¤FÂŦⳡ¤Àªº¥N½X¡A¦ý±NeÄæ²MªÅªº®É­Ô¡AhÄ檺¼Æ¦r«o¶]¨ì¤Fh1?(¥¿±`¬O­n¸òµÛ¬°ªÅ¡A¦ý«o§ï¤F§Úh1¥»¨Óªº¦r)
ÁÂÁ¡I

If .Column <> 5 Then Exit Sub
   For Each cell In Union(Range("E2:E" & Cells(Rows.Count, "E").End(3).Row), .Cells)
      st = IIf(Trim(cell) = "", "", IIf(Val(cell.Offset(0, -1)) > 0, "LOB", _
                    IIf(Application.WorksheetFunction.CountIf(cell, "S1A*") > 0, "TM", "MU")))
      cell.Offset(0, -3).Value = st
      cell.Offset(0, 3).Resize(, 2) = IIf(cell <> "", 2, "")
   Next

Andy2483

¦^´_ 6# wayne0303


For Each cell In Union(Me.Range("E2:E" & Me.Cells(Me.Rows.Count, "E").End(3).Row), .Cells)

wayne0303

¦^´_ 5# Andy2483


¤]¬O¤@¼Ë...

ÁÙ¬O¬O­n§ï¥Î±z3# ªºwith¼g©O¡H

Andy2483

¦^´_ 4# wayne0303


    ¥i¯à¬O³sÄòIJµo,½Ð¸Õ¸Õ3#ªº¤è®×
      Application.EnableEvents = False
      cell.Offset(0, -3).Value = st
      Application.EnableEvents = True

wayne0303

¦^´_ 2# Andy2483

·PÁÂandy¤j¤j¦^ÂÐ~

¤U­±³o¬q¥N½X¦b°õ¦æªº®É­Ô·|¦³©µ¿ðªºª¬ªp

• ¹³§Ú³£¨ú®øEÄ檺­È¤F¡ABÄ檺µ²ªGÁÙ¬O¨S¦³¸òµÛ¨ú®ø....
  
• E3¡BD3¦³­È¡AB3Åã¥Üµ²ªG¡A¦bE4¿é¤J¼Æ¾Ú¡AB3¤~·|µ¹§Ú¸õ¥¿½Tªºµ²ªG³o¼Ë...
  

    xA4:
Set xA = Intersect(Target, Range("E:E"))
If xA Is Nothing Then Exit Sub

Dim st As String
Dim cell As Range

For Each cell In Me.Range("E2:E" & Me.Cells(Me.Rows.Count, "E").End(3).Row)
    st = IIf(cell.Value = "", "", _
                IIf(cell.Offset(0, -1).Value > 0, "LOB", _
                    IIf(Application.WorksheetFunction.CountIf(cell, "S1A*") > 0, "TM", "MU")))
    cell.Offset(0, -3).Value = st
   
Next

Andy2483

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾Ç½m²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xR As Range, st$, cell As Range
Application.ScreenUpdating = False
With Target
   If .Column = 21 Then
      For Each xR In .Cells
         Cells(xR.Row, 1).Resize(, 22).Font.ColorIndex = 15 ^ -(Val(xR) > 1)
      Next
   End If
   If .Column = 15 Then
      For Each xR In .Cells
         Cells(xR.Row, 16).Resize(, 2).Font.ColorIndex = 2 ^ -(Trim(xR) = "")
      Next
   End If
   If .Column = 10 Then
      For Each xR In .Cells
         Cells(xR.Row, 10).Font.Color = RGB(0, 176, 240) ^ -(Trim(xR) = "L")
         Cells(xR.Row, 10).Font.Bold = (Trim(xR) = "L")
      Next
   End If
   If .Column = 22 Then
      For Each xR In .Cells
         Cells(xR.Row, 1).Resize(, 22).Font.Color = RGB(153, 102, 0) ^ -((xR Like "*©î¹Ï"))
      Next
   End If
   If .Column = 16 Then
      For Each xR In .Cells
         Cells(xR.Row, 1).Resize(, 22).Font.ColorIndex = 5 ^ -(xR.Font.Strikethrough = True)
      Next
   End If
   If .Column <> 5 Then Exit Sub
   For Each cell In Me.Range("E2:E" & Me.Cells(Me.Rows.Count, "E").End(3).Row)
      st = IIf(Trim(cell) = "", "", IIf(Val(cell.Offset(0, -1)) > 0, "LOB", _
                    IIf(Application.WorksheetFunction.CountIf(cell, "S1A*") > 0, "TM", "MU")))
      Application.EnableEvents = False
      cell.Offset(0, -3).Value = st
      Application.EnableEvents = True
   Next
End With
End Sub