ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

±N¸ê®Æ½Æ»s¨ì¤£¦Pªº¤u§@ªí

¥»©«³Ì«á¥Ñ stillfish00 ©ó 2012-12-10 20:20 ½s¿è

¦^´_ 1# fangsc
°Ñ¦Ò¬Ý¬Ý¤U­±µ{¦¡ , ¦ý¨ä¹ê¸ê®Æ¶q­Y¬O«Ü¤jªº¸Ü¤£¬O«Ü«Øijª½±µ¦bWorksheet_Change¨Æ¥ó¤º¥h³B²z
  1. Option Explicit
  2. Private Sub Worksheet_Change(ByVal Target As Range)
  3.     Dim ws As Worksheet
  4.     Dim r As Long
  5.     Dim sales As String
  6.                
  7.     Application.ScreenUpdating = False
  8.    
  9.     'clear header
  10.     For Each ws In Sheets
  11.         If not ws is Me Then
  12.             ws.UsedRange.Offset(1).ClearContents
  13.         End If
  14.     Next
  15.    
  16.     For r = 2 To Range("C" & Rows.Count).End(xlUp).Row
  17.         sales = Cells(r, "C").Value
  18.         
  19.         If sales <> "" Then
  20.             If Not hasSheet(sales) Then
  21.                 With Sheets.Add(After:=Sheets(Sheets.Count))
  22.                     .name = sales
  23.                     [A1:H1].Copy .[A1]
  24.                 End With
  25.             End If
  26.             
  27.             With Sheets(sales)
  28.                 .Range("C" & .Rows.Count).End(xlUp).Offset(1, -2).Resize(1, 8) = Range("A" & r & ":" & "H" & r).Value
  29.             End With
  30.         End If
  31.     Next r
  32.    
  33.     Me.Select
  34.     Application.ScreenUpdating = True
  35. End Sub

  36. Function hasSheet(name As String) As Boolean
  37.     Dim ws As Worksheet
  38.    
  39.     On Error Resume Next
  40.     Set ws = Sheets(name)
  41.     On Error GoTo 0
  42.    
  43.     If ws Is Nothing Then
  44.         hasSheet = False
  45.     Else
  46.         hasSheet = True
  47.     End If
  48.    
  49.     Set ws = Nothing
  50. End Function
½Æ»s¥N½X

TOP

        ÀR«ä¦Û¦b : ¡i®É¶¡¦¨´N¤@¤Á¡j®É¶¡¥i¥H³y´N¤H®æ¡A¥i¥H¦¨´N¨Æ·~¡A¤]¥i¥HÀx¿n¥\¼w¡C
ªð¦^¦Cªí ¤W¤@¥DÃD