将ORACLE标准的、丑陋的文本报表转换成Excel

seasonyun

下下来了，就是仍在研究使用方法中···

cnsaliuzhengji

能够坚持用oracle标准报表的用户还真是少啊，像楼主这样的真是厉害

windcry77

这么实用的东西一定要顶

ccl1023

楼主写的的确很漂亮的哈

云崖阁

Sub Macro1()
'
' Macro1 Macro
' Macro recorded 12/26/2007 by
'

'
'Dim curcell() As Byte

Dim setup_del_r As Integer
Dim setup_del_c As Integer
Dim setup_del_curcell As String
Dim find_del As Integer

Dim setup_sum_tag_r As Integer
Dim setup_sum_tag_c As Integer
Dim setup_sum_tag_curcell As String
Dim setup_sum_tag_curcell_n As String
Dim setup_sum_tag_r_h As Integer
Dim setup_sum_tag_r_c As Integer
Dim setup_sum_tag_curcell_h As String

Dim setup_sum_title_r As Integer
Dim setup_sum_title_c As Integer
Dim setup_sum_title_curcell As String

Dim setup_column_width_r As Integer
Dim setup_column_width_c As Integer
Dim setup_column_width_curcell As Integer
Dim setup_column_width_len As Integer

Dim setup_column_title_r As Integer
Dim setup_column_title_c As Integer
Dim setup_column_title_curcell As String

Dim source_curcell As String
Dim source_r As Integer
Dim source_c As Integer
Dim source_flag As String

Dim result_r As Integer
Dim result_c As Integer
Dim result_v1 As String
Dim result_curcell As String
Dim result_column_place As Integer
Dim result_v As String
Dim result_column_begin As Integer
Dim result_column_end As Integer
Dim result_del_count As Integer
Dim result_null_count As Integer
Dim result_sum_count As Integer
Dim result_column_count As Integer
Dim result_count As Integer
Dim result_sum_place1 As Integer
Dim result_sum_place2 As Integer
Dim r As Integer
Dim c As Integer

result_r = 1
result_c = 1

'Dim curcell As String
'curcell = Worksheets("sheet1").Cells(4, 3).Value

'curcell1 = StrConv(curcell, 128, 2052)

'Length = LenB(curcell1)

'MsgBox Length & curcell1

'10 初始化汇总标题_开始＝＝＝＝＝＝＝＝＝＝＝＝＝
'result_column_count = 0
'setup_sum_title_r = 2
'setup_sum_title_c = 3


'Do
'
'    setup_sum_title_curcell = Worksheets("SETUP").Cells(setup_sum_title_r, setup_sum_title_c).Value
'    If Len(setup_sum_title_curcell) > 0 Then
'        Worksheets("RESULT").Cells(result_r, result_c).Value = setup_sum_title_curcell
'        If Worksheets("SETUP").Cells(setup_sum_title_r, 7).Value = "文本" Then
'        Sheets("RESULT").Select
'        Columns(result_c).Select
'        Selection.NumberFormat = "@"
'        End If
'        setup_sum_title_r = setup_sum_title_r + 1
'        result_c = result_c + 1
'        Else
'        Exit Do
'    End If
'Loop Until setup_sum_title_curcell = ""
'
result_column_begin = result_c


'10 初始化汇总标题－结束＝＝＝＝＝＝＝＝＝＝＝＝

'20 初始化列标题－开始＝＝＝＝＝＝＝＝＝＝＝＝＝

setup_column_title_r = 2
setup_column_title_c = 5

Sheets("RESULT").Select
Cells.Select
Selection.ClearContents

Do

    setup_column_title_curcell = Worksheets("SETUP").Cells(setup_column_title_r, setup_column_title_c).Value
    If Len(setup_column_title_curcell) > 0 Then
        Worksheets("RESULT").Cells(result_r, result_c).Value = setup_column_title_curcell
        If Worksheets("SETUP").Cells(setup_column_title_r, 8).Value = "文本" Then
        Sheets("RESULT").Select
        Columns(result_c).Select
        Selection.NumberFormat = "@"
        End If
        If Worksheets("SETUP").Cells(setup_column_title_r, 8).Value = "金额" Then
        Sheets("RESULT").Select
        Columns(result_c).Select
        Selection.NumberFormat = "#,##0.00_);[Red](#,##0.00)"
        End If
        setup_column_title_r = setup_column_title_r + 1
        result_c = result_c + 1
        Else
        Exit Do
    End If
Loop Until setup_column_title_curcell = ""

result_column_end = result_c

'20 初始化列标题－结束＝＝＝＝＝＝＝＝＝＝＝＝＝＝

'30 读取数据大循环开始＝＝＝＝＝＝＝＝＝＝＝＝＝＝

source_r = 1
source_c = 1
source_curcell = Worksheets("SOURCE").Cells(source_r, source_c).Value
source_curcell = Replace(source_curcell, "", "")
result_count = 0
result_null_count = 0
result_del_count = 0
result_sum_count = 0
result_column_count = 0
setup_sum_tag_r = 2
setup_sum_tag_c = 2

Do

    If source_curcell <> "" Then
   
        '40 删除行循环开始＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
        source_flag = "NOTSKIP"
        setup_del_tag_r = 2
        setup_del_tag_c = 1
        setup_del_tag_curcell = Worksheets("SETUP").Cells(setup_del_tag_r, setup_del_tag_c).Value
        Do
        
            find_del = InStr(source_curcell, setup_del_tag_curcell)
            If find_del > 0 Then
                result_del_count = result_del_count + 1
                source_flag = "SKIP"
                Exit Do
                Else
                source_flag = "NOTSKIP"
               
            End If
            setup_del_tag_r = setup_del_tag_r + 1
            setup_del_tag_curcell = Worksheets("SETUP").Cells(setup_del_tag_r, setup_del_tag_c).Value
        Loop Until setup_del_tag_curcell = ""
        
        '40 删除行循环结束＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
        
        '50 汇总行循环开始＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
        If source_flag = "NOTSKIP" Then
            setup_sum_tag_r_h = 2
            setup_sum_tag_c_h = 2
            setup_sum_tag_curcell_h = Worksheets("SETUP").Cells(setup_sum_tag_r_h, setup_sum_tag_c_h).Value
            
            If InStr(source_curcell, setup_sum_tag_curcell_h) > 0 Then
                result_r = result_r + 1
                result_c = 1
                setup_sum_tag_r = 2
                setup_sum_tag_c = 2
            End If
            setup_sum_tag_curcell = Worksheets("SETUP").Cells(setup_sum_tag_r, setup_sum_tag_c).Value
            setup_sum_tag_curcell_n = Worksheets("SETUP").Cells(setup_sum_tag_r + 1, setup_sum_tag_c).Value
            Do
            result_sum_place1 = 0
            result_sum_place2 = 0
            result_sum_place1 = InStr(source_curcell, setup_sum_tag_curcell)
            result_sum_place2 = InStr(source_curcell, setup_sum_tag_curcell_n)
            
            
            If result_sum_place1 > 0 Then
           
              If result_sum_place1 > 0 And result_sum_place2 > 0 Then
           
              result_v = Left(source_curcell, result_sum_place2 - 1)
              result_v = Right(result_v, result_sum_place2 - result_sum_place1)
              result_v = Trim(Right(result_v, Len(result_v) - Len(setup_sum_tag_curcell)))
              Worksheets("RESULT").Cells(result_r, result_c).Value = result_v
              result_c = result_c + 1

              source_flag = "SKIP"
              End If
            
              If result_sum_place1 > 0 And result_sum_place2 = 0 Then
              result_v = Right(source_curcell, Len(source_curcell) - result_sum_place1 + 1)
              result_v = Trim(Right(result_v, Len(result_v) - Len(setup_sum_tag_curcell)))
              Worksheets("RESULT").Cells(result_r, result_c).Value = result_v
              result_c = result_c + 1
              result_sum_count = result_sum_count + 1
              source_flag = "SKIP"

              Exit Do
              End If
            Else
              source_flag = "NOTSKIP"
              Exit Do
            
            End If
             setup_sum_tag_r = setup_sum_tag_r + 1
             setup_sum_tag_curcell = Worksheets("SETUP").Cells(setup_sum_tag_r, setup_sum_tag_c).Value
             setup_sum_tag_curcell_n = Worksheets("SETUP").Cells(setup_sum_tag_r + 1, setup_sum_tag_c).Value
            
           Loop Until setup_sum_tag_curcell = "end"

        
        End If
        
        '50 汇总行循环结束＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
        
        '60 分列循环开始＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
        If source_flag = "NOTSKIP" Then
            setup_column_width_r = 2
            setup_column_width_c = 4
            result_column_place = 1
            setup_column_width_curcell = Worksheets("SETUP").Cells(setup_column_width_r, setup_column_width_c).Value
            If result_c >= result_column_begin Then
            result_c = result_column_begin
            result_r = result_r + 1
            End If
            result_v1 = ""
            Do

                result_v = Left(source_curcell, result_column_place)
                If LenB(StrConv(result_v, 128, 2052)) <= setup_column_width_curcell Then
                result_v1 = result_v1 & Right(result_v, 1)
                Else
                Worksheets("RESULT").Cells(result_r, result_c).Value = Trim(result_v1)
                result_v1 = ""
                result_c = result_c + 1
                setup_column_width_r = setup_column_width_r + 1
                setup_column_width_curcell = Worksheets("SETUP").Cells(setup_column_width_r, setup_column_width_c).Value
               
                End If
                result_column_place = result_column_place + 1
               

            Loop Until result_column_place > Len(source_curcell)

        Worksheets("RESULT").Cells(result_r, result_c).Value = result_v1
        result_column_count = result_column_count + 1

        End If


        '60 分列循环开始＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝


   
    Else
   
    result_null_count = result_null_count + 1
   
    End If
   
    result_count = result_count + 1
    source_r = source_r + 1
    source_curcell = Worksheets("SOURCE").Cells(source_r, source_c).Value
    source_curcell = Replace(source_curcell, "", "")
    Rows(result_r).Select
   
Loop Until source_curcell = "end"
   
    '30 读取数据大循环结束＝＝＝＝＝＝＝＝＝＝＝＝＝＝
   
    '100 删除拐弯行＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝


'Do
'setup_column_width_r = 2
'setup_column_width_c = 5
'result_c = result_column_begin
'
' Do
  '  If Worksheets("SETUP").Cells(setup_column_width_r, setup_column_width_c + 1) = "是" And Worksheets("RESULT").Cells(result_r, result_column_begin + setup_column_width_r - 2) = "" Then
   '
    '  Do
'      Worksheets("RESULT").Cells(result_r - 1, result_c).Value = Worksheets("RESULT").Cells(result_r - 1, result_c).Value & Worksheets("RESULT").Cells(result_r, result_c).Value
'     result_c = result_c + 1
'     Loop Until result_c >= result_column_end
'
  '  Rows(result_r).Select
  '  Selection.Delete Shift:=xlUp
   
   ' Exit Do
   ' ElseIf Worksheets("SETUP").Cells(setup_column_width_r, setup_column_width_c + 1) = "是" And Len(Worksheets("RESULT").Cells(result_r, result_column_begin + setup_column_width_r - 2)) > 0 Then
   ' Exit Do
   
   ' End If
   ' setup_column_width_r = setup_column_width_r + 1
  'Loop Until Worksheets("SETUP").Cells(setup_column_width_r, setup_column_width_c) = ""
'result_r = result_r - 1
'Rows(result_r).Select
'Loop Until result_r = 1
   
    '100 删除拐弯行＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
   
   
    MsgBox "共处理" & result_count & ";删除行" & result_del_count & ";空行" & result_null_count & ";汇总行" & result_sum_count & ";分列行" & result_column_count

End Sub

云崖阁

不懂数据库的悲剧，用了结果全是数据库里的东西啊

EBSOracle

先收了，LZ辛苦啦！

yxzxy_

好东西，先下载再慢慢看

zonghengedu

这只是把具体某张系统报表给转换了，能不能固定一个模板挂载到系统中，这类的报表就可以直接下载成EXCEL下来？刚刚接触EBS，让我把标准报表EXCEL输出，着实有点摸不着头脑……
静待回复！

marusu

谢谢分享！~