| ©«¤l835 ¥DÃD6 ºëµØ0 ¿n¤À915 ÂI¦W1  §@·~¨t²ÎWin 10,7 ³nÅ骩¥»2019,2013,2003 ¾\ŪÅv50 ©Ê§O¨k µù¥U®É¶¡2010-5-3 ³Ì«áµn¿ý2025-7-5 
 | 
                
| ¥»©«³Ì«á¥Ñ luhpro ©ó 2018-1-10 23:41 ½s¿è 
 ¤U¤èªþÀÉ : ¥unÅܧó¤u§@ªí A ¤¤¥ô¤@ ¡° ¤U¤èÀx¦s®æ(¦@¥|Ó)¤º®e, ¨ä¤Uªí®æ¤º®e´N·|§Y®É§ó·s.
 ===== ¥H¤U¤º®e©ñ¦b Module ========== ¥H¤U¤º®e©ñ¦b ThisWorkBook =====
 ===== ¥H¤U¤º®e©ñ¦b ¤u§@ªí5 (A) =====½Æ»s¥N½XPrivate Sub Workbook_Open()
  Dim iCol%
  Dim lRow&
  
  Set vData = CreateObject("Scripting.Dictionary")
  lRow = 2
  With Sheets("DATA")
    While .Cells(lRow, 4) & .Cells(lRow, 9) <> ""
      If .Cells(lRow, 2) <> "" Then
        vData(.Cells(lRow, 2) & "_" & .Cells(lRow, 3)) = lRow
      End If
      lRow = lRow + 1
    Wend
  End With
End Sub
½Æ»s¥N½XPrivate Sub Worksheet_Change(ByVal Target As Range)
  Dim iI%
  Dim lRow&
  Dim rSou As Range, rTar As Range
  Dim wsSou As Worksheet
  
  Set wsSou = Sheets("DATA")
  With Target
    Select Case "R" & .Row & "C" & .Column
      Case "R4C2", "R29C2", "R4C18", "R29C18"
Application.EnableEvents = False
        .Offset(2).Resize(20, 6).ClearContents
Application.EnableEvents = True
        For iI = 1 To 20
          If vData.Exists(.Value & "_" & iI) Then
            lRow = vData(.Value & "_" & iI)
Application.EnableEvents = False
            wsSou.Cells(lRow, 4).Resize(, 5).Copy .Offset(1 + iI)
Application.EnableEvents = True
          Else
            Exit For
          End If
        Next
        With .Offset(2).Resize(20, 6)
          .Font.Size = 16
          With .Borders(xlInsideVertical) ' ¦r¤Ó¤p,®Ø½u¤£¨£½Õ¾ã
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
          End With
          With .Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
          End With
        End With
    End Select
  End With
End Sub
 ½d¥»_Ans.zip (141.89 KB) 
     | 
 |