06
--
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
--
>>
<<
--
LATEST ENTRY
CATEGORY
ARCHIVE
PROFILE
SEARCH
RECENT COMMENT
  • 【情報】Excel で スクレイピング 【ぶっこ抜き】
    縫部尚登 (06/17)
  • 【QUICKFIX】 FX自動売買への道 18 【通貨ペアの取得(SecurityListRequest)】
    ganponfx (05/05)
  • 【QUICKFIX】 FX自動売買への道 18 【通貨ペアの取得(SecurityListRequest)】
    まこ (05/05)
  • 【QUICKFIX】 FX自動売買への道 18 【通貨ペアの取得(SecurityListRequest)】
    ganponfx (05/04)
  • 【QUICKFIX】 FX自動売買への道 18 【通貨ペアの取得(SecurityListRequest)】
    ganponfx (05/04)
  • 【QUICKFIX】 FX自動売買への道 18 【通貨ペアの取得(SecurityListRequest)】
    ganponfx (05/04)
  • 【QUICKFIX】 FX自動売買への道 18 【通貨ペアの取得(SecurityListRequest)】
    ganponfx (05/03)
  • 【QUICKFIX】 FX自動売買への道 18 【通貨ペアの取得(SecurityListRequest)】
    まこ (05/03)
  • 【QUICKFIX】 FX自動売買への道 18 【通貨ペアの取得(SecurityListRequest)】
    ganponfx (05/03)
  • エクセルファイルのパスワードを忘れたら・・・
    里奈 (09/09)
MOBILE
qrcode
OTHERS
<< 【情報】Excel で スクレイピング 【ぶっこ抜き】 | top | 【はじめての】PostgreSQL【データベース】 >>
スポンサーサイト

一定期間更新がないため広告を表示しています

スポンサードリンク | - | | - | - |
【全テーブル】Oracle -> CSV -> Excel【抽出】
必要に駆られて作ってみました
とりあえず動いているので公開♪

■概要
OracleデータをCSVファイルとして保存
CSVファイルをマクロで自動取込してExcel化します

OracleデータをCSV化する部分と、
CSVをExcel化する部分で出来てます。

 


■概要[ Oracle -> CSV ]部分
bash シェル(UNIX な Oracle 前提)
 ※Windows な Oracle の場合はbatファイルに書き換えてみてくださいです

1テーブルを1CSVファイルとして保存します
CSVのデータファイルの他にテーブル定義情報も作成します

sqlplus で Oracle に接続できるユーザで実行すること
シェルの中のOracleユーザ名、パスワードを書き換えが必要
実行すると進捗状況を表示するので、終了するまでじっくりと待ちます
実行後に全データをまとめた 〜.tar.gz ファイルを作成します
.tar.gz をExcelから見えるところに展開してくださいです


■概要[ CSV -> Excel ]部分

Excel 2007 で作成したマクロ
 2007以前でも動くかは未確認
1テーブルを1シートとして取り込みます

Excelのマクロ実行を有効化した状態で実行すること
 ※Excelのオプション
   -> セキュリティセンター
    -> セキュリティセンターの設定
     -> マクロの設定
      -> すべてのマクロを有効にする

マクロを実行して、上記の 〜.tar.gz を展開したフォルダを指定してくださいです
実行すると進捗状況を表示するので、終了するまでじっくりと待ちます



■詳細[ Oracle -> CSV ]部分
シェルを実行すると作業ディレクトリを作成します
作業ディレクトリ名は「yyyymmdd_`hostname`_$ORACLE_SID

作業ディレクトリ内に以下3種類のファイルを作成します
 テーブル名.head テーブル定義情報
 テーブル名.sql テーブルデータ抽出SQL
 テーブル名.data CSV化したテーブルデータ

sqlplus で Oracle に接続して、Oracleユーザが保持しているテーブル一覧を作成します(USER_TABLES)
テーブル毎に、テーブル定義情報と、データ抽出SQLを自動生成
データ抽出SQLは日付データなどを文字列に変換するように指定しています
・TIMESTAMP型は yyyy/mm/dd hh24:mi:ss.ff6 に
・DATE型は yyyy/mm/dd hh24:mi:ss に
・NUMBER型は TO_CHAR
・文字列型(CLOB,CHAR,VARCHAR2)は、CSVのダブルクォートをエスケープ処理

※上記以外のデータ型や、変換形式の修正は直接シェルを変更してくださいです


自動生成したデータ抽出SQL(テーブル名.sql)を実行して、CSVファイル(テーブル名.data)を作成
これを、テーブル一覧のテーブルをすべて処理するまで繰り返し

全テーブルを処理したら、作業ディレクトリを tar でまとめて gzip で圧縮します



■詳細[ CSV -> Excel ]部分
マクロを実行すると、取り込み対象のフォルダ指定のダイアログが開きます
Oracle -> CSV で作成した tar.gz ファイルを展開したフォルダを指定してください

フォルダが指定されると、中の テーブル名.head を全部取り込みます
 テーブル名.head から取り込み対象のテーブル名一覧と、テーブル毎のシートを作成
各シートにはテーブル名を書き込んで、一覧とのハイパーリンクを生成
テーブル定義情報を書き込んだら、ウィンドウ枠の固定も自動実行してます

すべての .head ファイルを取り込んだら、テーブル名.data ファイルのCSV取り込みを開始
 テーブル名.data ファイルを1行毎に読み込んで、ADODB.Stream によって文字コード変換を実施
該当テーブルのシートに文字コード変換をした行を追加

すべての テーブル名 .data ファイルを取り込んだら、終了します



■その他
作成するCSVファイルはダブルクォート囲みのカンマ区切り

シェルの動作確認は CentOS5.7 32bit と Redhat 5.4 64bit 上の Oracle 10g と 11g のみ
マクロの動作確認は WindowsXP SP3 の Excel2007 SP2 のみ
他の環境でも動くかは不明..

Oracleの文字コードは UTF8
他の文字コードを使っている場合は、マクロ内で文字コード変換も行っているので該当部分を適当に変更してみてくださいです..

動作確認がWindowsXPなので、VistaやWindows7などで文字化けした場合はマクロ内文字コード変換部分をいじってみてください..
事前にCSVファイル( .dataファイル)の文字コードを変換しておいても良いのかも


場合によってはダウンロードしたExcelを実行できない(してはいけない)こともあるかと思うので、新規からの実行手順についても記載しておきます
1.このページのマクロ部分を全部コピーしてメモ帳などに貼り付け、デスクトップなどに「C2E.bas」として保存
2.新規作成したエクセルでSHEET1のB2セルの名称を「No」に設定する(セルの内容ではなく、名称・名前の定義)
3.[ALT+F11]を押して、マクロ画面を開く
4.マクロ画面で[CTRL+M]を押してファイルのインポート画面を開く
5.手順1で保存したファイルを指定してインポートする
6.インポートしたマクロ内の[Public Sub C2E_main()] にカーソルを当て、[F5]を押してマクロを実行する





■[ Oracle -> CSV ]シェル ( o2c.bash )

それでは Oracle から CSV ファイルを作成するシェルです
以下をコピペして、実行してやってください
実行するときには、オラクルのユーザとパスワードを書き換えてから♪

#!/bin/bash

#=====================================================================
#:: Setting
export orauser=scott
export orapass=tiger

#=====================================================================
#:: Work Directory
export dirname="`date +%Y%m%d`_`hostname`_$ORACLE_SID"
mkdir ./$dirname
cd    ./$dirname

#=====================================================================
#== TABLE LIST
sqlplus -S $orauser/$orapass  <<  EOT  >  ./table.lst
set pages 0
set line 32767
set head off
set feed off
set termout off
set trimout on
select TABLE_NAME
  from USER_TABLES
  order by 1
/
QUIT
EOT

#=====================================================================
#== ALL TABLE LOOP
export num=1
export max=`cat ./table.lst | wc -l`
for i in `cat ./table.lst`
do
echo ==[ `date +%Y/%m/%d_%H:%M:%S` ] $num / $max : $i

#===HEADER ===========================================================
sqlplus -S $orauser/$orapass << EOT | ¥
awk '{A=A $1; B=B $2;} END{printf("%s¥n%s¥n",A,B);}'  >  $i.head
set pages 0
set line 32767
set head off
set feed off
set termout off
set trimout on
select
       '"'||COLUMN_NAME||'",'
       , '"'||
       decode( DATA_TYPE
         , 'CHAR',         DATA_TYPE || '('|| DATA_LENGTH    ||')'
         , 'VARCHAR2',     DATA_TYPE || '('|| DATA_LENGTH    ||')'
         , 'NUMBER',       DATA_TYPE || '('|| DATA_PRECISION ||')'
         , 'TIMESTAMP(6)', 'TIMESTAMP'
         , DATA_TYPE
       )
       ||'",'
  from USER_TAB_COLUMNS
 where TABLE_NAME = '$i'
 order by COLUMN_ID
/
QUIT
EOT

#===BODY -1- =========================================================
cat  <<  EOT  >  $i.sql
set pages 0
set line 32767
set loboffset 1
set long 2000000000
set longchunksize 2000000000
set head off
set feed off
set termout off
set trimout on
set trimspool on
SELECT
EOT

#===BODY -2- =========================================================
sqlplus -S $orauser/$orapass  <<  EOT  >>  $i.sql
set pages 0
set line 32767
set head off
set feed off
set termout off
set trimout on
select
       decode( COLUMN_ID, 1, '  ', '||') ||
       '''"''||'||
       decode( DATA_TYPE
       , 'TIMESTAMP(6)', 'TO_CHAR('|| COLUMN_NAME ||', ''yyyy/mm/dd hh24:mi:ss.ff6'')'
       , 'DATE',         'TO_CHAR('|| COLUMN_NAME ||', ''yyyy/mm/dd hh24:mi:ss'')'
       , 'NUMBER',       'TO_CHAR('|| COLUMN_NAME ||')'
       , 'CLOB',         'REPLACE('|| COLUMN_NAME ||', ''"'', ''""'')'
       , 'CHAR',         'REPLACE('|| COLUMN_NAME ||', ''"'', ''""'')'
       , 'VARCHAR2',     'REPLACE('|| COLUMN_NAME ||', ''"'', ''""'')'
       , COLUMN_NAME
       ) ||'||''",'''
  from USER_TAB_COLUMNS
 where TABLE_NAME = '$i'
 order by COLUMN_ID
/
QUIT
EOT

#===BODY -3- =========================================================
cat  <<  EOT  >>  $i.sql
  FROM $i
 WHERE 1=1

spool $i.data
/
EOT

#===EXEC SQL =========================================================
sqlplus -S $orauser/$orapass <  $i.sql  >  /dev/null

#=====================================================================
#== TABLE LOOP END
export num=`expr $num + 1`
done

#=====================================================================
#== Compress
cd ..
tar cvfz $dirname.tar.gz ./$dirname
#openssl enc -e -aes256 -in ./$dirname.tar.gz -out ./$dirname.tar.gz.enc



以上
シェル部分でした




■[ CSV -> Excel ]マクロ( c2e.bas )

次にエクセルマクロ部分
以下をコピーして、拡張子 bas のファイルとして保存
エクセルマクロからインポートして Sub C2E_main() 実行してください

Option Explicit

Private TableStartRow As Long
Private TableMaxRow As Long
Private TableListRow As Long

Private cBook As String
Private cSheet As String

Private Const adReadLine As Long = -2
Private Const adReadAll  As Long = -1

Private Const adTypeBinary As Long = 1
Private Const adTypeText   As Long = 2

Private Const adCR   As Long = 13  '改行復帰を示します。
Private Const adCRLF As Long = -1  '既定値です。改行復帰行送りを示します。
Private Const adLF   As Long = 10  '行送りを示します。

Private Const C2E_Error123 As String = "対象フォルダを指定してください。 code=123"
Private Const C2E_Error125 As String = "フォルダが見つかりませんでした。 code=125"
Private Const C2E_Error223 As String = "シートが見つかりませんでした。 code=223"
Private Const C2E_Error224 As String = "データファイルが見つかりませんでした。  code=224"


'// メイン処理

Public Sub C2E_main()
    Dim Folder As String
    Dim Sheet As String

    '// ワークブック名、シート名保持
    cBook = ActiveWorkbook.Name
    cSheet = ActiveSheet.Name

    '// フォルダ設定

    On Error Resume Next
    ChDir (ActiveWorkbook.Path)
    On Error GoTo 0

    '// 対象フォルダ選択

    Folder = C2E_dialog()
    If Folder = "" Then C2E_ErrorEnd (C2E_Error123)

    '// テーブル一覧初期化
    Call C2E_SheetClean

    '// テーブル一覧の開始位置設定

    TableStartRow = Workbooks(cBook).Sheets(cSheet).Range("No").row
    TableListRow = TableStartRow + 1

    '// すべての定義ファイルを取得

    Call C2E_GetHeaderFile(Folder, cSheet)

    '// すべてのデータファイルを取得

    Call C2E_GetDataFile(Folder, cSheet)

End Sub


'// すべてのデータファイルを取得

Private Sub C2E_GetDataFile(Folder, Sheet)

    Dim Table As String
    Dim File As String
    Dim i As Long

    '// エラー抑止

    On Error Resume Next

    '// テーブル名一覧ループ

    For i = TableStartRow + 1 To TableMaxRow

        '// 処理がうまく進むおまじない

        DoEvents

        '// 処理対象フォーカス

        Workbooks(cBook).Sheets(Sheet).Range("C" & i).Select

        '// テーブル名取得

        Table = Trim(Workbooks(cBook).Sheets(Sheet).Range("C" & i).Value2)

        '// テーブル名シート確認

        Err.Clear
        Debug.Print Workbooks(cBook).Sheets(Table).Name
        If Err.Number <> 0 Then
            Workbooks(cBook).Sheets(Sheet).Range("D" & i).Value2 = "'ERR"
            Workbooks(cBook).Sheets(Sheet).Range("E" & i).Value2 = C2E_Error223
            GoTo NEXT_I:
        End If

        '// ファイル存在確認

        File = Folder & "¥" & Table & ".data"
        If Len(Trim(Dir(File, vbNormal))) = 0 Then
            Workbooks(cBook).Sheets(Sheet).Range("D" & i).Value2 = "'ERR"
            Workbooks(cBook).Sheets(Sheet).Range("E" & i).Value2 = C2E_Error224
            GoTo NEXT_I:
        End If

        '// ファイル内容取り込み

        Call C2E_ReadDataFile(File, Table, Sheet, i)

NEXT_I:
    '// テーブル名一覧ループ END

    Next i

    '// テーブル名一覧にフィルターを設定

    If i > TableStartRow Then
        Workbooks(cBook).Sheets(Sheet).Rows(TableStartRow & ":" & (i - 1)).AutoFilter
    End If

    '// エラー抑止解除

    On Error GoTo 0

End Sub



'// ファイル内容取り込み
Private Sub C2E_ReadDataFile(File, Table, Sheet, row)

    Dim Line As Long
    Dim UTF8 As Object
    Dim wk As String

    '// 読み込みレコード数初期化

    Workbooks(cBook).Sheets(Sheet).Range("D" & row).Value2 = 0

    '// オブジェクト用意 文字コード変換のため

    Set UTF8 = CreateObject("ADODB.Stream")
    With UTF8
        .Open
        .Charset = "UTF-8"
        .Type = adTypeText
        .LineSeparator = adLF
    End With

    '// ファイルを1行ずつ取り込み

    Line = 4
    UTF8.LoadFromFile (File)
    Do While Not (UTF8.EOS)

        '// 処理がうまく進むおまじない

        DoEvents

        '// 1行読み込み

        wk = Replace(UTF8.ReadText(adReadLine), Chr(13), "")

        '// SQL> は削除

        If Trim(wk) = "SQL>" Then wk = ""
        If Trim(wk) = "SQL> /" Then wk = ""

        '// 対象データ有無確認

        If Len(Trim(wk)) <> 0 Then

            '// 改行文字対応

            Do While Not ((Right(wk, 2) = """,") Or (UTF8.EOS))
                wk = wk & vbLf & Replace(UTF8.ReadText(adReadLine), Chr(13), "")
            Loop

            '// 読み込み行を CSV データ分割(文字として)

            Workbooks(cBook).Sheets(Table).Range("A" & Line).Value2 = wk
            Sheets(Table).Range("A" & Line).TextToColumns _
                Destination:=Range("A" & Line), _
                DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, _
                ConsecutiveDelimiter:=False, _
                Tab:=False, _
                Semicolon:=False, _
                Comma:=True, _
                Space:=False, _
                Other:=False, _
                FieldInfo:=Array( _
                    Array(1, 2), Array(2, 2), Array(3, 2), Array(4, 2), Array(5, 2), Array(6, 2), Array(7, 2), Array(8, 2), Array(9, 2), _
                    Array(10, 2), Array(11, 2), Array(12, 2), Array(13, 2), Array(14, 2), Array(15, 2), Array(16, 2), Array(17, 2), Array(18, 2), Array(19, 2), Array(20, 2), Array(21, 2), Array(22, 2), Array(23, 2), Array(24, 2), Array(25, 2), Array(26, 2), Array(27, 2), Array(28, 2), Array(29, 2), Array(30, 2), Array(31, 2), Array(32, 2), Array(33, 2), Array(34, 2), Array(35, 2), Array(36, 2), Array(37, 2), Array(38, 2), Array(39, 2), Array(40, 2), Array(41, 2), Array(42, 2), Array(43, 2), Array(44, 2), Array(45, 2), Array(46, 2), Array(47, 2), Array(48, 2), Array(49, 2), _
                    Array(50, 2), Array(51, 2), Array(52, 2), Array(53, 2), Array(54, 2), Array(55, 2), Array(56, 2), Array(57, 2), Array(58, 2), Array(59, 2), Array(60, 2), Array(61, 2), Array(62, 2), Array(63, 2), Array(64, 2), Array(65, 2), Array(66, 2), Array(67, 2), Array(68, 2), Array(69, 2), Array(70, 2), Array(71, 2), Array(72, 2), Array(73, 2), Array(74, 2), Array(75, 2), Array(76, 2), Array(77, 2), Array(78, 2), Array(79, 2), Array(80, 2), Array(81, 2), Array(82, 2), Array(83, 2), Array(84, 2), Array(85, 2), Array(86, 2), Array(87, 2), Array(88, 2), Array(89, 2), Array(90, 2), Array(91, 2), Array(92, 2), Array(93, 2), Array(94, 2), Array(95, 2), Array(96, 2), Array(97, 2), Array(98, 2), Array(99, 2), _
                    Array(100, 2), Array(101, 2), Array(102, 2), Array(103, 2), Array(104, 2), Array(105, 2), Array(106, 2), Array(107, 2), Array(108, 2), Array(109, 2), Array(110, 2), Array(111, 2), Array(112, 2), Array(113, 2), Array(114, 2), Array(115, 2), Array(116, 2), Array(117, 2), Array(118, 2), Array(119, 2), Array(120, 2), Array(121, 2), Array(122, 2), Array(123, 2), Array(124, 2), Array(125, 2), Array(126, 2), Array(127, 2), Array(128, 2), Array(129, 2), Array(130, 2), Array(131, 2), Array(132, 2), Array(133, 2), Array(134, 2), Array(135, 2), Array(136, 2), Array(137, 2), Array(138, 2), Array(139, 2), Array(140, 2), Array(141, 2), Array(142, 2), Array(143, 2), Array(144, 2), Array(145, 2), Array(146, 2), Array(147, 2), Array(148, 2), Array(149, 2), _
                    Array(150, 2), Array(151, 2), Array(152, 2), Array(153, 2), Array(154, 2), Array(155, 2), Array(156, 2), Array(157, 2), Array(158, 2), Array(159, 2), Array(160, 2), Array(161, 2), Array(162, 2), Array(163, 2), Array(164, 2), Array(165, 2), Array(166, 2), Array(167, 2), Array(168, 2), Array(169, 2), Array(170, 2), Array(171, 2), Array(172, 2), Array(173, 2), Array(174, 2), Array(175, 2), Array(176, 2), Array(177, 2), Array(178, 2), Array(179, 2), Array(180, 2), Array(181, 2), Array(182, 2), Array(183, 2), Array(184, 2), Array(185, 2), Array(186, 2), Array(187, 2), Array(188, 2), Array(189, 2), Array(190, 2), Array(191, 2), Array(192, 2), Array(193, 2), Array(194, 2), Array(195, 2), Array(196, 2), Array(197, 2), Array(198, 2), Array(199, 2), _
                    Array(200, 2), Array(201, 2), Array(202, 2), Array(203, 2), Array(204, 2), Array(205, 2), Array(206, 2), Array(207, 2), Array(208, 2), Array(209, 2), Array(210, 2), Array(211, 2), Array(212, 2), Array(213, 2), Array(214, 2), Array(215, 2), Array(216, 2), Array(217, 2), Array(218, 2), Array(219, 2), Array(220, 2), Array(221, 2), Array(222, 2), Array(223, 2), Array(224, 2), Array(225, 2), Array(226, 2), Array(227, 2), Array(228, 2), Array(229, 2), Array(230, 2), Array(231, 2), Array(232, 2), Array(233, 2), Array(234, 2), Array(235, 2), Array(236, 2), Array(237, 2), Array(238, 2), Array(239, 2), Array(240, 2), Array(241, 2), Array(242, 2), Array(243, 2), Array(244, 2), Array(245, 2), Array(246, 2), Array(247, 2), Array(248, 2), Array(249, 2), _
                    Array(250, 2), Array(251, 2), Array(252, 2), Array(253, 2), Array(254, 2), Array(255, 2), Array(256, 2), Array(257, 2), Array(258, 2), Array(259, 2), Array(260, 2), Array(261, 2), Array(262, 2), Array(263, 2), Array(264, 2), Array(265, 2), Array(266, 2), Array(267, 2), Array(268, 2), Array(269, 2), Array(270, 2), Array(271, 2), Array(272, 2), Array(273, 2), Array(274, 2), Array(275, 2), Array(276, 2), Array(277, 2), Array(278, 2), Array(279, 2), Array(280, 2), Array(281, 2), Array(282, 2), Array(283, 2), Array(284, 2), Array(285, 2), Array(286, 2), Array(287, 2), Array(288, 2), Array(289, 2), Array(290, 2), Array(291, 2), Array(292, 2), Array(293, 2), Array(294, 2), Array(295, 2), Array(296, 2), Array(297, 2), Array(298, 2), Array(299, 2) _
                ), _
                TrailingMinusNumbers:=True

            '// 読み込みレコード数表示

            Workbooks(cBook).Sheets(Sheet).Range("D" & row).Value2 = Line - 3

            '// カウントアップ

            Line = Line + 1
        End If
    Loop

    '// ファイルクローズ

    UTF8.Close
    Set UTF8 = Nothing

    '// 行高調整

    Workbooks(cBook).Sheets(Table).Rows("4:" & Line).EntireRow.AutoFit

    '// フィルター設定

    If Line > 4 Then
        Workbooks(cBook).Sheets(Table).Rows("3:" & (Line - 1)).AutoFilter
    End If

End Sub



'// すべての定義ファイルを取得
Private Sub C2E_GetHeaderFile(Folder, SheetName)

    Dim File As String
    Dim Table As String

    '// フォルダの存在確認

    If Len(Trim(Dir(Folder, vbDirectory))) = 0 Then C2E_ErrorEnd (C2E_Error125 & vbCrLf & Folder)

    '// フォルダ内の HEAD ファイルをすべて取得

    File = Dir(Folder & "¥¥*.head", vbNormal)
    Do While File <> ""

        '// 処理がうまく進むおまじない

        DoEvents

        '// ファイル名からテーブル名を取得

        Table = Left(File, Len(File) - Len(".head"))

        '// 旧テーブルシート削除

        Call C2E_DeleteSheet(Table)

        '// HEAD ファイル取り込み

        Call C2E_OpenHeader(Folder, File, Table, cBook, SheetName)

        '// テーブル一覧に書き込み

        Workbooks(cBook).Sheets(SheetName).Activate
        Workbooks(cBook).Sheets(SheetName).Range("B" & TableListRow).Value2 = TableListRow - TableStartRow
        Workbooks(cBook).Sheets(SheetName).Range("C" & TableListRow).Value2 = Table

        '// テーブル名とシートのハイパーリンク追加

        Workbooks(cBook).Sheets(SheetName).Range("C" & TableListRow).Select
        ActiveSheet.Hyperlinks.Add _
            Anchor:=Selection, _
            Address:="", _
            SubAddress:=Table & "!A1"
        Selection.Font.Size = 9

        '// テーブル一覧に罫線追加

        Call C2E_SetRowStyle("B", "E", SheetName)

        '// 次行設定

        Debug.Print File
        File = Dir()
        TableListRow = TableListRow + 1

    Loop

    '// テーブル一覧の最大行を覚えておく

    TableMaxRow = TableListRow - 1

End Sub



'// 旧テーブルシート削除
Private Sub C2E_DeleteSheet(TableName)

    '// エラー無視
    On Error Resume Next

    '// 削除確認ダイアログの表示抑制

    Application.DisplayAlerts = False

    '// シート削除

    Workbooks(cBook).Sheets(TableName).Delete

    '// 抑制復帰

    Application.DisplayAlerts = True

    '// エラー無視解除

    On Error GoTo 0

End Sub



'// 定義ファイル(ヘッダー情報)取り込み
Private Sub C2E_OpenHeader(Folder, File, Table, Workbook, Sheet)


    '// 画面表示抑制

    Application.ScreenUpdating = False

    '// 読み込み

    Workbooks.OpenText _
        Filename:=Folder & "¥" & File, _
        Origin:=65001, _
        StartRow:=1, _
        DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, _
        Tab:=False, _
        Semicolon:=False, _
        Comma:=True, _
        Space:=False, _
        Other:=False, _
        TrailingMinusNumbers:=True

    '// 文字サイズ縮小

    Cells.Select
    With Selection.Font
        .Name = "MS Pゴシック"
        .Size = 9
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With

    '// セル種別を「文字」に設定

    Cells.Select
    Selection.NumberFormatLocal = "@"

    '// 読み込んだシートを移動

    ActiveWorkbook.Sheets(Table).Move After:=Workbooks(Workbook).Sheets(Workbooks(Workbook).Sheets.Count)

    '// テーブル名 追加

    ActiveSheet.Rows("1:1").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    ActiveSheet.Range("A1").Select
    ActiveSheet.Range("A1").FormulaR1C1 = Table

    '// 区切り線

    With ActiveSheet.Rows("3:3")
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        .Borders(xlEdgeLeft).LineStyle = xlNone
        .Borders(xlEdgeTop).LineStyle = xlNone
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlMedium
        End With
        .Borders(xlEdgeRight).LineStyle = xlNone
        .Borders(xlInsideVertical).LineStyle = xlNone
        .Borders(xlInsideHorizontal).LineStyle = xlNone
    End With

    '// ウィンドウ枠の固定

    ActiveSheet.Range("A4").Select
    ActiveWindow.FreezePanes = True

    '// テーブル名とシートのハイパーリンク追加

    ActiveSheet.Range("A1").Select
    ActiveSheet.Hyperlinks.Add _
        Anchor:=Selection, _
        Address:="", _
        SubAddress:=Sheet & "!C" & TableListRow
    Selection.Font.Size = 9

    '// コントロールシートに戻る

    ActiveWorkbook.Sheets(Sheet).Activate

    '// 表示抑制解除

    Application.ScreenUpdating = True

End Sub



'// テーブル一覧に罫線追加
Private Sub C2E_SetRowStyle(StartCol, EndCol, SheetName)

    '// エラー時は無視
    On Error Resume Next

    '// 対象行 選択

    Sheets(SheetName).Range(StartCol & TableListRow & ":" & EndCol & TableListRow).Select

    '// 罫線クリア

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone

    '// 罫線作成

    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With

    '// 背景色設定(偶数行のみ)

    If (TableListRow Mod 2) = 0 Then
        With Selection.Interior
            .Pattern = xlNone
            .TintAndShade = 0
        End With
    Else
        With Selection.Interior
            .PatternTintAndShade = 0
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorDark2
            .TintAndShade = -9.99786370433668E-02
            .PatternTintAndShade = 0
        End With
    End If

    '// エラー無視解除

    On Error GoTo 0

End Sub



'// 致命的エラー 強制終了
Private Sub C2E_ErrorEnd(msg)

    Dim code As Long
    code = MsgBox(msg, vbCritical)
    End
End Sub


'// テーブル一覧初期化
Private Sub C2E_SheetClean()

    Dim StartRow As Long
    Dim MaxRow As Long

    '// 一覧の開始行設定 = セル名「No」の次の行からが一覧

    StartRow = Workbooks(cBook).Sheets(cSheet).Range("No").row + 1

    '// 一覧の終了行設定 = 記入のある最大行までが一覧

    MaxRow = ActiveCell.SpecialCells(xlLastCell).row

    '// 開始と終了の位置関係の補正

    If MaxRow < StartRow Then MaxRow = StartRow

    '// 一覧の初期化

    Workbooks(cBook).Sheets(cSheet).Rows(StartRow & ":" & MaxRow).Delete Shift:=xlUp

    '// フィルターがあれば解除

    If Workbooks(cBook).Sheets(cSheet).AutoFilterMode Then
        Workbooks(cBook).Sheets(cSheet).Range("A1").AutoFilter
    End If

End Sub



'// 対象フォルダ選択
Private Function C2E_dialog() As String

    If Application.FileDialog(msoFileDialogFolderPicker).Show Then
        C2E_dialog = Trim(Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1))
    Else
        C2E_dialog = ""
    End If
End Function




以上
途中けっこう無茶なこともしてますけど、
まぁ常用するものじゃないし、動けばOKなんです




Oracle の業務データを見たかったんですけど、実際に生データに触れる機会がほんとに少なくて..
数少ない機会に、Oracleデータを根こそぎ持ってきてしまえ!! と思って作ったシェルとマクロがこれです。

実際にはもうちょっと特定データだけを抽出するようにしてありますが、それはシェルをちょいっと改造していただければ♪


シェルやマクロが動かなかったら連絡してくださいです。
「空白」にも意味があったりしますから、もうそのままコピペしたほうが幸せになれるとおもいます


まこ | 開発 | 00:43 | comments(0) | trackbacks(0) |
スポンサーサイト
スポンサードリンク | - | 00:43 | - | - |
Comment









Trackback
URL: