Archive for the 'Excel v.X' Category

2009/12/22 Excel選択範囲から各種文字列長のデータをピックアップ v6

Excel上の選択範囲から、各種文字列長のデータをピックアップするAppleScriptです。

Excel上に日本人の名前が姓と名の間に半角スペースが入った状態で並んでいたとして……諸般の都合でこれを姓1文字+名1文字のパターン、姓1文字+名2文字のパターンなど……さまざまな文字長に場合分けして、それぞれの文字長に最初に合致したデータをピックアップする、というものです。

excel1.jpg

Excelからデータを取得してはいますが、実際にはリストに突っ込んでゴリゴリ回しています。処理速度の向上のためにa reference toで高速化を行っており、これによって10倍以上は高速化できています(多くて数百件ぐらいのデータを処理していたので、割とすぐに結果が返ってきます@Core 2 Duo 2.4GHz)。

これも、最初は手作業で行っていたのですが、「そのぐらい、プログラムで処理すれば一瞬だ!」とブチ切れて、すぐに最初の試作品を作成。運用しているうちに、どんどん改良を加えて、半日もたたないうちにここまで機能が追加されました。

スクリプト名:Excel選択範囲から各種文字列長のデータをピックアップ v6
set procList to {{1, 1}, {1, 2}, {2, 1}, {2, 2}, {1, 3}, {3, 1}, {2, 3}, {3, 2}, {3, 3}}
global gaList, gaList_r
global aSelection, aSelection_r
global gaaList, gaaList_r

tell application “Microsoft Excel”
  set aSelection to formula of selection
end tell
set aSelection_r to a reference to aSelection

set gaList to {}
set gaList_r to a reference to gaList

set dameList to {}

repeat with i in aSelection_r
  set j to contents of first item of i
  
set j to repChar(j, “ ”, ” “) of me –全角スペースを半角に置換しておく
  
  
if j ends with ” “ then
    set j to deleteBackSPC(j) of me
  end if
  
  
considering hyphens
    considering white space
      set j0 to offset of ” “ in j
      
if j0 is not equal to 0 then
        set j1 to text 1 thru (j0 - 1) of j
        
        
set revJ to (reverse of (characters of j)) as string
        
set j00 to offset of ” “ in revJ
        
set j2 to text ((length of j) - j00 + 2) thru -1 of j
      else
        set j0 to offset of “ ” in j
        
if j0 is not equal to 0 then
          set j1 to text 1 thru (j0 - 1) of j
          
          
set revJ to (reverse of (characters of j)) as string
          
set j00 to offset of “ ” in revJ
          
set j2 to text ((length of j) - j00 + 2) thru -1 of j
        else
          set the end of dameList to j
        end if
      end if
    end considering
  end considering
  
  
set the end of gaList_r to {j, j1, j2, {length of j1, length of j2}}
end repeat

if dameList is not equal to {} then
  choose from list dameList with prompt “だめだった名前のリスト”
end if

set gaaList to {}
set gaaList_r to a reference to gaaList
repeat with i in procList
  set j to contents of i
  
set tmpList to {}
  
  
repeat with ii in gaList_r
    set jj to contents of item 4 of ii
    
set jj2 to contents of ii
    
if jj = j then
      set the end of tmpList to jj2
      
exit repeat
    end if
  end repeat
  
  
set the end of gaaList_r to {j, tmpList}
end repeat

gaaList
–> {{{1, 1}, {{”ぴ よ”, “ぴ”, “よ”, {1, 1}}}}, {{1, 2}, {{”ぴ よ子”, “ぴ”, “よ子”, {1, 2}}}}, {{2, 1}, {{”ぴよ こ”, “ぴよ”, “こ”, {2, 1}}}}, {{2, 2}, {{”ぴよ まる”, “ぴよ”, “まる”, {2, 2}}}}, {{1, 3}, {{”ぴ よまる”, “ぴ”, “よまる”, {1, 3}}}}, {{3, 1}, {{”ぴよま る”, “ぴよま”, “る”, {3, 1}}}}, {{2, 3}, {{”ぴよ まるお”, “ぴよ”, “まるお”, {2, 3}}}}, {{3, 2}, {{”ぴよま るお”, “ぴよま”, “るお”, {3, 2}}}}, {{3, 3}, {{”ぴよま るるこ”, “ぴよま”, “るるこ”, {3, 3}}}}}

on deleteBackSPC(a)
  set aCount to 1
  
considering hyphens
    considering white space
      
      
set aList to reverse of characters of a
      
repeat with i in aList
        set j to contents of i
        
if j is not in {” “, “  ”, “ ”} then
          exit repeat
        end if
        
        
set aCount to aCount + 1
        
      end repeat
      
    end considering
  end considering
  
  
set aa to text 1 thru ((length of a) - aCount + 1) of a
  
return aa
  
end deleteBackSPC

–文字置換ルーチン
on repChar(origText, targStr, repStr)
  set {txdl, AppleScript’s text item delimiters} to {AppleScript’s text item delimiters, targStr}
  
set temp to text items of origText
  
set AppleScript’s text item delimiters to repStr
  
set res to temp as text
  
set AppleScript’s text item delimiters to txdl
  
return res
end repChar

▼新規書類に ▼カーソル位置に ▼ドキュメント末尾に

2008/12/14 Excel v.Xでウィンドウ枠の分割を固定

Excelで最もよく行う操作のひとつ、「ウィンドウ枠の固定」をExcel v.Xに対して行うAppleScriptです。分割位置を縦と横に対して指定し、メニューからコマンドを実行する必要があるわけですが、AppleScriptからは割と簡単に指定・実行が行えます。

xlvx1.jpeg

xlvx2.jpeg

xlvx3.jpeg

スクリプト名:Excel v.Xでウィンドウ枠の分割を固定
tell application "Microsoft Excel"
  tell Window 1
    set fStat to FreezePanes
    
if fStat = false then
      set SplitColumn to 1 水平分割位置=1列
      
set SplitRow to 1  垂直分割位置=1行
      
set FreezePanes to true
    end if
  end tell
end tell

▼新規書類に ▼カーソル位置に ▼ドキュメント末尾に

2008/12/14 Excel v.Xで最前面のウィンドウを最大化する

Excel v.Xで最前面のウィンドウの表示を最大化、つまり画面一杯に表示します。

スクリプト名:Excel v.Xで最前面のウィンドウを最大化する
tell applicationMicrosoft Excel
  set aWin to ActiveWindow
  
  
tell aWin
    set WindowState to xlMaximized
  end tell
end tell

▼新規書類に  ▼カーソル位置に  ▼ドキュメント末尾に

2008/12/11 Excel v.Xで新規ドキュメントを作成して任意のワークシートを作成

Excel v.Xで新規ドキュメント(ワークブック)を作成し、そこにA〜Eの指定名称のワークシートを作成するAppleScriptです。v.Xではまだ手探り状態のExcelの用語辞書も、2004で大幅に方針転換を行い、2008で2004の辞書に追加を行ったという進化をたどってきました。

excelvx.jpeg

スクリプト名:Excel v.Xで新規ドキュメントを作成して任意のワークシートを作成
set sList to {”A“, B“, C“, D“, E“}

tell application Microsoft Excel
  set nDoc to Create New document
  
tell ActiveWorkbook
    set wsCount to count every Worksheet
    
    
repeat (5 - wsCount) times
      Create New Worksheet
    end repeat
    
    
repeat with i from 1 to 5
      set newName to contents of item i of sList
      
set Name of Worksheet i to newName
    end repeat
  end tell
end tell

▼新規書類に ▼カーソル位置に ▼ドキュメント末尾に