Archive for the 'Excel 2004' 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

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

2009/07/26 10進数数値をExcel 2004_2008的カラム表現にエンコード

Excel 2004/2008でセルの位置を指定する際、Excel v.Xまでの「R1C1形式」ではなく「A1形式」が採用されました。数値をこのA1形式に変換するためのAppleScriptサブルーチンです。

R1C1形式は非常に扱いが簡単で、これがそのまま使えればよかったのですが……(汗)

Excelで、縦軸を表すcellオブジェクトと、横軸を表すcolumnオブジェクトを使って、

  set a to formula of cell 3 of column 2 –セル「B3」にアクセス

といったR1C1形式に近い表記は可能ですが、範囲指定をする際にはA1形式が必要になってしまいます。

A1形式は、最初のアルファベット部分がカラム(列)を、数値部分がロー(行)を示しています。

このA1形式のカラム部分の計算を行うのが本サブルーチンです。ただし、1〜1,351までの範囲を対象としています。このA1形式のカラム部分は単なる26進数ではなく、少々トリッキーな計算(というか補正)が必要になってしまい、その計算で保証できる範囲が1,351ということです。

ex1.jpg

本気で作り込めば、もうちょっと大きな数値まで対象にできそうですが、実用上1,351まで変換することはなさそうです。Excel 2008ではカラムが16,384まで持てるようになってはいるものの、そんなに大きな表を扱うのであれば、いっそFileMaker Proなどのデータベースを用いたほうが楽に処理できることでしょう。

本ルーチンについても、最善の内容ではなく表現範囲を限定した上でのいわば「次善」の内容であり、他にもっとよいものがあれば使っていきたいところ。海外でいろいろ探しまわったものの、この処理については適切なものが見つからなかったので、仕方なく作成した次第です。

そもそも、Windows版ExcelでVisualBasicから呼び出すメソッドには10進数とA1形式の相互変換を行うものがあるので、それがMac OS X版に実装されていないことが問題の根源のような気もします。

スクリプト名:10進数数値をExcel 2004_2008的カラム表現にエンコード
set aRes to aNumToExcelColumn(502) of me
> “SH”

10進数数値をExcel 2004/2008的カラム表現にエンコードするサブルーチン
1〜1351までの間であれば正しいエンコーディング結果を返す
on aNumToExcelColumn(origNum)
  if origNum > 1351 then
    display dialog エラー:Excel 2004/2008的カラム表現(A1形式)への変換ルーチンにおいて、想定範囲外(1351以上)のパラメータが指定されました buttons {”OK“} default button 1
    
return “”
  end if
  
  
set upperDigitEncTable to {”A“, B“, C“, D“, E“, F“, G“, H“, I“, J“, K“, L“, M“, N“, O“, P“, Q“, R“, S“, T“, U“, V“, W“, X“, Y“, Z“, A“}
  
set lowerDigitEncTable to {”A“, B“, C“, D“, E“, F“, G“, H“, I“, J“, K“, L“, M“, N“, O“, P“, Q“, R“, S“, T“, U“, V“, W“, X“, Y“, Z“, A“}
  
  
set oNum to origNum
  
set nTh to 26
  
set stringLength to 4
  
  
数字が1桁の場合の対応
  
if origNum < 27 then
    set aRes to (item origNum of upperDigitEncTable) as string
    
return aRes
  end if
  
  
  
if origNum > 702 then
    3桁になる場合
    
set upupNum to oNum div 676 整数除算–上の上の桁
    
set oNum to oNum - (upupNum * 676)
    
set upNum to oNum div 26 整数除算–上の桁
    
set lowNum to oNum mod 26 - 1 余剰計算–下の桁
    
    
log {origNum, upupNum, upNum, lowNum}
    
    
超つじつま合わせルーチン【強引】
    
if lowNum = -1 then
      set upNum to upNum - 1
      
set lowNum to 25
    end if
    
    
set upupChar to (item upupNum of upperDigitEncTable) as string
    
set upChar to (item upNum of upperDigitEncTable) as string
    
set lowChar to (item (lowNum + 1) of lowerDigitEncTable) as string
    
set resText to upupChar & upChar & lowChar
    
  else
    2桁の場合
    
set upNum to oNum div 26 整数除算–上の桁
    
set lowNum to oNum mod 26 - 1 余剰計算–下の桁
    
    
    
超つじつま合わせルーチン【強引】
    
if lowNum = -1 then
      set upNum to upNum - 1
      
set lowNum to 25
    end if
    
    
set upChar to (item upNum of upperDigitEncTable) as string
    
set lowChar to (item (lowNum + 1) of lowerDigitEncTable) as string
    
set resText to upChar & lowChar
    
  end if
  
  
return resText
  
end aNumToExcelColumn

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

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

Excel v.2004/2008でアクティブワークシートのウィンドウ枠の分割を固定します。
(more…)

2008/12/14 Excel v.2004/2008でウィンドウの最大化

Excel v.2004/2008で表示中のワークシート(ウィンドウ)を最大化します。画面いっぱいにウィンドウを表示します。
(more…)

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

Excel v.2004/2008で新規ドキュメント(ワークブック)を作成し、そこにA〜Eの指定名称のワークシートを作成するAppleScriptです。
(more…)