[µo°Ý] «D±`½ÆÂø¿ï¾Ü¸ò¤ñ¹ï,·í¿ï¾ÜH2®É,¥i¥H±o¨ì I2:L12 ªºµ²ªG?

metrostar

¾Ç©f¤S¨Ó³Â·Ð¤j®a¤F
¥´¶} EXCEL Àɦ³¸Ô²Ó»¡©ú³á
½Ð«Ó­ô/¬ü¤kª©¥D «Ó­ô/¬ü¤k¾Çªø¸ò¾Ç©j
À°¦£¾Ç©f§¹¦¨
ÁÂÁ¤F

Hsieh

¦^´_ 1# metrostar

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. Dim A As Range, C As Range, Ar()
   
3. If Intersect(Target, [H2]) Is Nothing Then Exit Sub
   
4. Set A = [E:E].Find(Target, lookat:=xlWhole)
   
5. If A Is Nothing Then Exit Sub
   
6. ReDim Preserve Ar(s)
   
7. Ar(s) = Array([B1].Value, [C1].Value, [D1].Value, [F1].Value)
   
8. s = s + 1
   
9.    For Each C In A.MergeArea
   
10.      ReDim Preserve Ar(s)
    
11.      Ar(s) = Array(C.Offset(, -3).MergeArea(1).Value, C.Offset(, -2).MergeArea(1).Value, C.Offset(, -1).MergeArea(1).Value, C.Offset(, 1).MergeArea(1).Value)
    
12.      s = s + 1
    
13.     Next
    
14. Application.EnableEvents = False
    
15. [I:L] = ""
    
16. With Range("I1")
    
17.    .Resize(s, 4) = Application.Transpose(Application.Transpose(Ar))
    
18.    .CurrentRegion.Offset(, 1).Sort key1:=.Range("A1"), Header:=xlYes
    
19. End With
    
20. Application.EnableEvents = True
    
21. End Sub

½Æ»s¥N½X

luhpro

¾Ç©f¤S¨Ó³Â·Ð¤j®a¤F
¥´¶} EXCEL Àɦ³¸Ô²Ó»¡©ú³á
½Ð«Ó­ô/¬ü¤kª©¥D «Ó­ô/¬ü¤k¾Çªø¸ò¾Ç©j
À°¦£¾Ç©f§¹¦¨
ÁÂ ...
metrostar µoªí©ó 2013-8-25 10:52

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.   Dim iCount1%, iCount2%, iI%
   
3.   Dim lRow As Long, lRows As Long, lTRow As Long
   
4.   Dim sMod1$, sMod2$
   
5.   Dim bUse As Boolean
   
6.   
   
7.   With Target
   
8. Application.EnableEvents = False
   
9.     Range(.Offset(, 1), .Offset(10, 4)).Delete Shift:=xlShiftToLeft
   
10.     If .Row = 2 And .Column = 8 Then '[H2]
    
11.       With .Parent
    
12.         lRow = .Cells(Rows.Count, 1).End(xlUp).Row
    
13.         lRows = .Cells(Rows.Count, 5).End(xlUp).Row
    
14.         If lRow > lRows Then lRows = lRow
    
15.         lTRow = 0
    
16.         bUse = False
    
17.         For lRow = 2 To lRows
    
18.           If Trim(.Cells(lRow, 1).Text) = Trim(Target) Then
    
19.             Target.Offset(lTRow, 1) = .Cells(lRow, 2)
    
20.             Target.Offset(lTRow, 2) = .Cells(lRow, 3)
    
21.             bUse = True
    
22.           End If
    
23.          
    
24.           If Trim(.Cells(lRow, 5).Text) = Trim(Target) Then
    
25.             Target.Offset(lTRow, 3) = .Cells(lRow, 4)
    
26.             Target.Offset(lTRow, 4) = .Cells(lRow, 6)
    
27.             bUse = True
    
28.           End If
    
29.           If bUse Then lTRow = lTRow + 1
    
30.         Next lRow
    
31.       End With
    
32.     End If
    
33.     With Range(.Offset(, 1), .Offset(10, 4))
    
34.       .Interior.ColorIndex = 39
    
35.       .VerticalAlignment = xlCenter
    
36.       .HorizontalAlignment = xlCenter
    
37.       .Borders.LineStyle = xlContinuous
    
38.     End With
    
39. Application.EnableEvents = True
    
40.   End With
    
41. End Sub

½Æ»s¥N½X

metrostar201308-a.zip (11.25 KB)

¤U¸ü¦¸¼Æ: 9

2013-8-27 00:21