Application.Range应用一例

ning84

1. Private Sub CopyRng()
   
2.    Dim Rng As Range, oRng As Range
   
3.    Dim Rr As Range
   
4.       
   
5.    Dim Rng1 As Range, Rng2 As Range
   
6.        Set Rng = Selection
   
7.    Dim Sht As Worksheet
   
8.        Set Sht = Application.Worksheets("GeneralTable")
   
9.        Sht.Activate
   
10.    Dim oRow:
    
11.        oRow = Sht.Range("C65536").End(3).Row
    
12.        If oRow < 3 Then
    
13.            oRow = 9
    
14.        End If
    
15.        ''
    
16.        Set Rng = Sht.Range("A3:N" & oRow)
    
17.        ''Debug.Print Rng.Address
    
18.        Rng.ClearContents
    
19.        Rng.UnMerge
    
20.        Rng.Font.Size = 9
    
21.        Rng.ClearFormats
    
22.        ''
    
23.        oRow = 3
    
24.        Set Rng = Application.Range(Sht.Cells(1, "A").Formula)
    
25.       
    
26.        'Set Rng1 = Application.Range(Sht.Cells(1, "B").Formula)
    
27.        Set Rng2 = Application.Range(Sht.Cells(1, "C").Formula)
    
28.        ''
    
29.        Set Rr = Application.Range(Sht.Cells(1, "G").Formula)
    
30.     Dim R1 As Range, R2 As Range, R3 As Range
    
31.        Set R1 = Application.Range(Sht.Cells(1, "D").Formula)
    
32.        Set R2 = Application.Range(Sht.Cells(1, "E").Formula)
    
33.        Set R3 = Application.Range(Sht.Cells(1, "F").Formula)
    
34.       
    
35.       
    
36.        ''
    
37.        For ii = 1 To Rng.Rows.Count
    
38.            Set Rng1 = Application.Range(Sht.Cells(1, "B").Formula)
    
39.            Select Case Rng(ii, 19)
    
40.                Case "A6", "A7", "A8"
    
41.                    Rng1.Copy
    
42.                Case Else
    
43.                    Set Rng1 = Rng1.Resize(Rng1.Rows.Count - 1, Rng1.Columns.Count)
    
44.                    Rng1.Copy
    
45.            End Select
    
46.            Sht.Cells(oRow, 1) = Rng(ii, 1) & ".SLDDRW"
    
47.            
    
48.            Sht.Cells(oRow + 1, 1).PasteSpecial
    
49.            Sht.Cells(oRow + 1, 1) = Rng(ii, 1)
    
50.            ''
    
51.            Set oRng = Sht.Cells(oRow + 1, "A").Resize(Rng1.Rows.Count, Rng1.Columns.Count)
    
52.            Rng(ii, 20) = Rng1.Parent.Name & "!" & oRng.Address
    
53.            
    
54.            Select Case Rng(ii, 19)
    
55.                 Case "A6", "A7", "A8"
    
56.                     Set oRng = oRng.Resize(Rng.Rows.Count, 1)
    
57.                     ''Debug.Print oRng.Address
    
58.                     oRng.MergeCells = True
    
59.            End Select
    
60.            ''
    
61.            Rr.Copy
    
62.            Set oRng = Sht.Cells(oRow + R1.Row - Rng1.Row, 1 + R1.Column - Rng1.Column)
    
63.            oRng.PasteSpecial
    
64.            Set oRng = oRng(2, 1).Resize(R1.Rows.Count, R1.Columns.Count)
    
65.            'Debug.Print oRng.Address
    
66.            Rng(ii, 21) = Rng1.Parent.Name & "!" & oRng.Address
    
67.            
    
68.            ''
    
69.            Set oRng = Sht.Cells(oRow + R2.Row - Rng1.Row, 1 + R2.Column - Rng1.Column)
    
70.            oRng.PasteSpecial
    
71.            Set oRng = oRng(2, 1).Resize(R2.Rows.Count, R2.Columns.Count)
    
72.            'Debug.Print oRng.Address
    
73.            Rng(ii, 22) = Rng1.Parent.Name & "!" & oRng.Address
    
74.            ''
    
75.            Set oRng = Sht.Cells(oRow + R3.Row - Rng1.Row, 1 + R3.Column - Rng1.Column)
    
76.            oRng.PasteSpecial
    
77.            Select Case Rng(ii, 19)
    
78.                 Case "A6", "A7", "A8"
    
79.                     Set oRng = oRng(2, 1).Resize(R3.Rows.Count, R3.Columns.Count)
    
80.                 Case Else
    
81.                     Set oRng = oRng(2, 1).Resize(R3.Rows.Count - 1, R3.Columns.Count)
    
82.            End Select
    
83.            'Debug.Print oRng.Address
    
84.            'Stop
    
85.            Rng(ii, 23) = Rng1.Parent.Name & "!" & oRng.Address
    
86.            ''
    
87.            
    
88.            
    
89.            ''
    
90.            Rng2.Copy
    
91.            Sht.Cells(oRow + 1, "N").PasteSpecial
    
92.            For jj = 1 To Rng2.Rows.Count
    
93.                If Not IsEmpty(Rng2(jj, 1)) Then
    
94.                    Sht.Cells(oRow + jj, 2) = Rng2(jj, 2)
    
95.                End If
    
96.            Next jj
    
97.            'Stop
    
98.            oRow = oRow + 1 + Rng1.Rows.Count
    
99.        Next ii
    
100. End Sub
     

复制代码