做的oracle-自动生成dataload导入模板

wt577

主要做的实现研发费用-费用化转研发费用-资本化  模板的自动生成，然后通过dataload 软件导入到Oracle-ERP中

研发费用-费用化和研发费用-资本化  二级科目相同设置，是导入实现的关键。
根据每月资本化项目列表筛选出要资本化的条目，然后生成模板。


先加载加载宏。

wt577

加入了字典写法

Private MaxRow2 As Integer, shtname As String

Sub data_Filter()
Dim Crng, MaxRow1 As Integer, Maxcol1 As Integer
        shtname = Application.InputBox("请输入Oracle明细账名称", "输入名称", "201704月明细账")
        ActiveSheet.Name = shtname
         Application.DisplayAlerts = False
        For Each wbsh In ActiveWorkbook.Sheets
              If wbsh.Name = "研发费用本月明细" Then
               wbsh.Delete
              End If
        Next
       MaxRow1 = ActiveSheet.[A1].CurrentRegion.Rows.Count
       Maxcol1 = ActiveSheet.[A1].CurrentRegion.Columns.Count
       MaxRow2 = MaxRow1 + 100
       Set Crng = Application.InputBox("条件单元格区域", "条件区域", "$I$901:$I$907", , , , , 8)
    ActiveSheet.[A1].Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Range(Selection, Selection.End(xlDown)).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Crng, _
    CopyToRange:=Range("A" & MaxRow2), Unique:=False
    Sheets.Add.Name = "研发费用本月明细"
    Sheets(shtname).Select
    Range("A" & MaxRow2).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("研发费用本月明细").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub
Sub Dataload()
            Dim Rowmax1 As Integer
            Dim Rowmax2 As Integer
            Dim Rowmax3 As Integer
            Dim I As Integer, J As Integer, m As Integer, R As Integer, W As Integer
            Dim Rowmax4 As Integer, Rowmax5 As Integer
            Dim wbsh As Worksheet
            Dim arr(1 To 10000, 1 To 16) As Variant
            Dim H As Integer
            Dim arr1(1 To 10000, 1 To 16) As Variant
            Application.ScreenUpdating = False
            Rowmax1 = ActiveSheet.Range("A1").CurrentRegion.Rows.Count
            Rowmax2 = Rowmax1 + 2
            Rowmax4 = Rowmax1 + 1
             Application.DisplayAlerts = False
                    For Each wbsh In ActiveWorkbook.Sheets
                      If wbsh.Name = "Dataload" Then
                       wbsh.Delete
                      End If
                    Next

            For I = 1 To Rowmax1
                    arr(I, 1) = Cells(I, 11) & "." & Cells(I, 12) & "." & Cells(I, 13) & "." & Cells(I, 15) & "." _
                               & Cells(I, 19) & "." & Cells(I, 20) & "." & Cells(I, 22) & "." & Cells(I, 23)
                    arr(I, 2) = "TAB"
                    arr(I, 3) = Cells(I, 27)
                    arr(I, 4) = "TAB"
                    arr(I, 5) = Cells(I, 7)
                    arr(I, 6) = "TAB"
                    arr(I, 7) = Cells(I, 31)
                    arr(I, 8) = arr(I, 6)
                    arr(I, 9) = Cells(I, 32)
                    arr(I, 10) = "TAB"
                    arr(I, 11) = Cells(I, 33)
                    arr(I, 12) = "TAB"
                    arr(I, 13) = Cells(I, 35)
                    arr(I, 14) = "TAB"
                    arr(I, 15) = Cells(I, 36)
                    arr(I, 16) = "ENT"
                    arr(1, 1) = "科目代码"
         Next I
                    Sheets.Add.Name = "Dataload"
                    ActiveSheet.[A1].Resize(Rowmax1, 16) = arr
                          Set dic = CreateObject("scripting.dictionary")
                            For J = 1 To Rowmax1
                                            If dic.exists(arr(J, 1)) Then
                                                     m = dic(arr(J, 1))
                                                    arr1(m, 3) = arr1(m, 3) + arr(J, 3)
                                            Else
                                                           k = k + 1
                                                          For u = 1 To UBound(arr, 2)
                                                                dic(arr(J, 1)) = k
                                                                arr1(k, u) = arr(J, u)
                                                          Next u
                                            End If
                             Next J
                         ActiveSheet.Range("A" & Rowmax2).Resize(Rowmax1, 16) = arr1

                          For R = 2 To Rowmax1
                           H = InStr(1, Cells(R, 1), 5301)
                           Cells(R, 1) = WorksheetFunction.Replace(Cells(R, 1), H, 6, 530101)
                         Next R
                         Rowmax3 = ActiveSheet.Range("A" & Rowmax2).CurrentRegion.Rows.Count
                         Rowmax5 = Rowmax2 + Rowmax3
                         For W = Rowmax2 + 1 To Rowmax5 - 1
                            Cells(W, 3) = -Cells(W, 3)
                         Next W

                Rows(Rowmax4 & ":" & Rowmax2).Select
                Selection.Delete Shift:=xlUp
                Columns("A:P").Select
                Columns("A:P").EntireColumn.AutoFit
                With Selection
                    .HorizontalAlignment = xlLeft
                    .VerticalAlignment = xlCenter
                    .WrapText = False
                    .Orientation = 0
                    .AddIndent = False
                    .IndentLevel = 0
                    .ShrinkToFit = False
                    .ReadingOrder = xlContext
                    .MergeCells = False
                End With
                Rows("2:2").Select
                ActiveWindow.FreezePanes = True
                 Sheets(shtname).Select
                    Rows(MaxRow2 & ":" & MaxRow2).Select
                    Range(Selection, Selection.End(xlDown)).Select
                    Selection.Delete Shift:=xlUp
                    Sheets("Dataload").Select
                    Application.DisplayAlerts = True
End Sub

Sub call_all()
Call data_Filter
Call Dataload

End Sub

wt577

1. Private MaxRow2 As Integer, shtname As String
   
2. 
   
3. Sub data_Filter()
   
4. Dim Crng, MaxRow1 As Integer, Maxcol1 As Integer
   
5.         shtname = Application.InputBox("请输入Oracle明细账名称", "输入名称", "201704月明细账")
   
6.         ActiveSheet.Name = shtname
   
7.          Application.DisplayAlerts = False
   
8.         For Each wbsh In ActiveWorkbook.Sheets
   
9.               If wbsh.Name = "研发费用本月明细" Then
   
10.                wbsh.Delete
    
11.               End If
    
12.         Next
    
13.        MaxRow1 = ActiveSheet.[A1].CurrentRegion.Rows.Count
    
14.        Maxcol1 = ActiveSheet.[A1].CurrentRegion.Columns.Count
    
15.        MaxRow2 = MaxRow1 + 100
    
16.        Set Crng = Application.InputBox("条件单元格区域", "条件区域", "$I$901:$I$907", , , , , 8)
    
17.     ActiveSheet.[A1].Select
    
18.     Range(Selection, Selection.End(xlToRight)).Select
    
19.     Range(Selection, Selection.End(xlDown)).Select
    
20.     Application.CutCopyMode = False
    
21.     Range(Selection, Selection.End(xlDown)).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Crng, _
    
22.     CopyToRange:=Range("A" & MaxRow2), Unique:=False
    
23.     Sheets.Add.Name = "研发费用本月明细"
    
24.     Sheets(shtname).Select
    
25.     Range("A" & MaxRow2).Select
    
26.     Range(Selection, Selection.End(xlToRight)).Select
    
27.     Range(Selection, Selection.End(xlDown)).Select
    
28.     Selection.Copy
    
29.     Sheets("研发费用本月明细").Select
    
30.     Range("A1").Select
    
31.     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    
32.         :=False, Transpose:=False
    
33. End Sub
    
34. Sub Dataload()
    
35.             Dim Rowmax1 As Integer
    
36.             Dim Rowmax2 As Integer
    
37.             Dim Rowmax3 As Integer
    
38.             Dim I As Integer, J As Integer, m As Integer, R As Integer, W As Integer
    
39.             Dim Rowmax4 As Integer, Rowmax5 As Integer
    
40.             Dim wbsh As Worksheet
    
41.             Dim arr(1 To 10000, 1 To 16) As Variant
    
42.             Dim H As Integer
    
43.             Dim arr1(1 To 10000, 1 To 16) As Variant
    
44.             Application.ScreenUpdating = False
    
45.             Rowmax1 = ActiveSheet.Range("A1").CurrentRegion.Rows.Count
    
46.             Rowmax2 = Rowmax1 + 2
    
47.             Rowmax4 = Rowmax1 + 1
    
48.              Application.DisplayAlerts = False
    
49.                     For Each wbsh In ActiveWorkbook.Sheets
    
50.                       If wbsh.Name = "Dataload" Then
    
51.                        wbsh.Delete
    
52.                       End If
    
53.                     Next
    
54.             
    
55.             For I = 1 To Rowmax1
    
56.                     arr(I, 1) = Cells(I, 11) & "." & Cells(I, 12) & "." & Cells(I, 13) & "." & Cells(I, 15) & "." _
    
57.                                & Cells(I, 19) & "." & Cells(I, 20) & "." & Cells(I, 22) & "." & Cells(I, 23)
    
58.                     arr(I, 2) = "TAB"
    
59.                     arr(I, 3) = Cells(I, 27)
    
60.                     arr(I, 4) = "TAB"
    
61.                     arr(I, 5) = Cells(I, 7)
    
62.                     arr(I, 6) = "TAB"
    
63.                     arr(I, 7) = Cells(I, 31)
    
64.                     arr(I, 8) = arr(I, 6)
    
65.                     arr(I, 9) = Cells(I, 32)
    
66.                     arr(I, 10) = "TAB"
    
67.                     arr(I, 11) = Cells(I, 33)
    
68.                     arr(I, 12) = "TAB"
    
69.                     arr(I, 13) = Cells(I, 35)
    
70.                     arr(I, 14) = "TAB"
    
71.                     arr(I, 15) = Cells(I, 36)
    
72.                     arr(I, 16) = "ENT"
    
73.                     arr(1, 1) = "科目代码"
    
74.          Next I
    
75.                     Sheets.Add.Name = "Dataload"
    
76.                     ActiveSheet.[A1].Resize(Rowmax1, 16) = arr
    
77.                           Set dic = CreateObject("scripting.dictionary")
    
78.                             For J = 1 To Rowmax1
    
79.                                             If dic.exists(arr(J, 1)) Then
    
80.                                                      m = dic(arr(J, 1))
    
81.                                                     arr1(m, 3) = arr1(m, 3) + arr(J, 3)
    
82.                                             Else
    
83.                                                            k = k + 1
    
84.                                                           For u = 1 To UBound(arr, 2)
    
85.                                                                 dic(arr(J, 1)) = k
    
86.                                                                 arr1(k, u) = arr(J, u)
    
87.                                                           Next u
    
88.                                             End If
    
89.                              Next J
    
90.                          ActiveSheet.Range("A" & Rowmax2).Resize(Rowmax1, 16) = arr1
    
91.                        
    
92.                           For R = 2 To Rowmax1
    
93.                            H = InStr(1, Cells(R, 1), 5301)
    
94.                            Cells(R, 1) = WorksheetFunction.Replace(Cells(R, 1), H, 6, 530101)
    
95.                          Next R
    
96.                          Rowmax3 = ActiveSheet.Range("A" & Rowmax2).CurrentRegion.Rows.Count
    
97.                          Rowmax5 = Rowmax2 + Rowmax3
    
98.                          For W = Rowmax2 + 1 To Rowmax5 - 1
    
99.                             Cells(W, 3) = -Cells(W, 3)
    
100.                          Next W
     
101.                      
     
102.                 Rows(Rowmax4 & ":" & Rowmax2).Select
     
103.                 Selection.Delete Shift:=xlUp
     
104.                 Columns("A:P").Select
     
105.                 Columns("A:P").EntireColumn.AutoFit
     
106.                 With Selection
     
107.                     .HorizontalAlignment = xlLeft
     
108.                     .VerticalAlignment = xlCenter
     
109.                     .WrapText = False
     
110.                     .Orientation = 0
     
111.                     .AddIndent = False
     
112.                     .IndentLevel = 0
     
113.                     .ShrinkToFit = False
     
114.                     .ReadingOrder = xlContext
     
115.                     .MergeCells = False
     
116.                 End With
     
117.                 Rows("2:2").Select
     
118.                 ActiveWindow.FreezePanes = True
     
119.                  Sheets(shtname).Select
     
120.                     Rows(MaxRow2 & ":" & MaxRow2).Select
     
121.                     Range(Selection, Selection.End(xlDown)).Select
     
122.                     Selection.Delete Shift:=xlUp
     
123.                     Sheets("Dataload").Select
     
124.                     Application.DisplayAlerts = True
     
125. End Sub
     
126. 
     
127. Sub call_all()
     
128. Call data_Filter
     
129. Call Dataload
     
130. 
     
131. End Sub
     
132. 
     

复制代码