­ã´£³¡ªL

¤è®×¤@¡G½Æ»s¤u§@ªí©Î§ó·s¤º®e¡]¦pªG¤H­û¤u§@ªí¤w¦s¦b¡^

1. Sub §ó·s()
   
2. Dim xR As Range, MySht As Worksheet, Sht As Worksheet, AR, i%
   
3. Set MySht = ActiveSheet
   
4. MySht.AutoFilterMode = False
   
5. Application.ScreenUpdating = False
   
6. For Each xR In Range(MySht.[A2], MySht.[A65536].End(xlUp))
   
7.     If xR.Row = 1 Then Exit Sub
   
8.     On Error Resume Next
   
9.     Set Sht = Nothing:  Set Sht = Sheets(xR.Value)
   
10.     On Error GoTo 0
    
11.     If Sht Is Nothing Then
    
12.        Sheets("ªí®æ½d¥»").Copy After:=Sheets(Sheets.Count)
    
13.        Set Sht = ActiveSheet:  Sht.Name = xR.Value
    
14.        MySht.Select
    
15.     End If
    
16.     AR = Array("B3", "B4", "E3", "E4", "B6", "B7")
    
17.     For i = 0 To UBound(AR)
    
18.         Sht.Range(AR(i)) = ""
    
19.         If xR(1, i + 1) <> "" Then Sht.Range(AR(i)) = xR(1, i + 1).Text
    
20.     Next i
    
21. Next
    
22. End Sub

½Æ»s¥N½X

¤è®×¤G¡G¥H¤@±iªí¦@¥Î

1. Sub ¥Ó½Ðªí()
   
2. Dim xR As Range, AR
   
3. Set xR = ActiveCell
   
4. If xR.Row = 1 Or xR.Column > 1 Or xR.Value = "" Then
   
5.     MsgBox "½Ð¦b¢ÏÄæ¿ï¾Ü­n¶ñ¤J¥Ó½Ðªíªº¤H­û©m¦W¡I¡@": Exit Sub
   
6. End If
   
7. AR = Array("B3", "B4", "E3", "E4", "B6", "B7")
   
8. With Sheets("¥Ó½Ðªí")
   
9.      For i = 0 To UBound(AR)
   
10.          .Range(AR(i)) = ""
    
11.          If xR(1, i + 1) <> "" Then .Range(AR(i)).Value = xR(1, i + 1).Text
    
12.      Next i
    
13.      .Select
    
14. End With
    
15. End Sub

½Æ»s¥N½X

¡@
Xl0000027.rar (13.97 KB)

¤U¸ü¦¸¼Æ: 9

2016-11-6 11:41

¡@
¡@