Open Office 3.2 Calc である値に一致したセルを含む

質問

Open Office 3.2 Calc である値に一致したセルを含む行を別のシートに抜き出し一覧にする方法を教えてください。
例えば、

Sheet1 という名前のシートに
行1　1,いぬ,,5
行2　8,ねこ,a,9
行3　11,いぬ,b,d
のようなデータがあるとして、

行1から順番に見ていき、列B(左から2番目)の値が いぬ という文字列の場合に、
Sheet2 という名前のシートに、
行1から順番に、そっくりそのまま参照(コピーではなく)するように値を入力し、
行1　='Sheet1'.A1,='Sheet1.B1',='Sheet1.C1',='Sheet1.D1'
行2　='Sheet1'.A3,='Sheet1.B3',='Sheet1.C3',='Sheet1.D3'
とするということです。
例は3行ですが、実際には不規則に大量にあります。(例では奇数行に いぬ がありますが、実際はそういう規則性はありません)

数式でやろうとしましたが、規則的に連続していないものを詰めて並べるのは不可能だと思いました。
マクロでもできるのかわかりませんが、どんな関数、プロパティを使ったら出来るのかでもよいので教えてください。

私は基本的なOpen Office BasicなどOpen Officeがサポートしているスクリプト言語なら理解できます。

回答No.2

mimeu

私も OpenOffice に取組んでまだ１ヶ月ですので、
たぶんまだ見苦しい習作ですが、お目にかけます。

' Sheet1 の B列が Key_Word なら、その行のA～D列を Sheet2 と Sheet3 に転記する
'　　前提：　B列は全部 String だと仮定する。空白セルが出てきたらそこで終る。
' (注）　私の流儀ですが、変数には末尾に数字をつけて予約語と区別しています。

Const Key_Word = "いぬ"

Sub Main
Dim Sheet1 as Object, Sheet2 as Object, Sheet3 as Object
Dim Row1 as long, Row2 as long, Row3 as long ' Sheet1, Sheet2, Sheet3 の処理行
Dim Cell1 as Object, c0 as long, s0 as string
Sheet1 = ThisComponent.Sheets.GetByName("Sheet1")
Sheet2 = ThisComponent.Sheets.GetByName("Sheet2")
Sheet3 = ThisComponent.Sheets.GetByName("Sheet3")
' どのシートも２行目から始まるものと仮定する → 実際は変更を要するハズ
Row1 = 1 : Row2 = 1 : Row3 = 1
Do
Cell1 = Sheet1.getCellByPosition(1, Row1)
' （注） com.sun.star.table.CellContentType.EMPTY = 0 なので
If Cell1.Type = 0 Then End
if Cell1.Type = 2 Then
s0 = Cell1.String
if s0 = Key_Word Then
For c0 = 0 to 3
Copy_Cell (Sheet1, Row1, c0, Sheet2, Row2)
Copy_Cell (Sheet1, Row1, c0, Sheet3, Row2)
Next c0
Row2 = Row2 + 1
Row3 = Row3 + 1
End If
End If
Row1 = Row1 + 1
Loop
End Sub

' Copy と言う名ですが、ご覧の通り、Copy ではなく転記しています
Private Sub Copy_Cell (Sheet1 as Object, Row1 as Long, Col0 as Long, Sheet0, Row0 as Long)
Dim Cell1 as Object, Cell0 as Object
Cell1 = Sheet1.getCellByPosition(Col0, Row1)
Cell0 = Sheet0.getCellByPosition(Col0, Row0)
Select Case Cell1. Type
Case 1: Cell0.Value = Cell1.Value ' VALUE
Case 2: Cell0.String = Cell1.String ' TEXT
Case 3: Cell0.Formula = Cell1.Formula ' FORMULA
End Select
End Sub

回答No.1

himajin100000

'OOo-Dev 3.4(DEV300m88)で検証。
'コメントでリファレンス該当部を示した。少し過剰かも。
'他参考:http://docs.sun.com/app/docs/doc/817-1826
'字数が
Sub Main()
Dim i As Integer
Dim j As Integer
Dim n As Integer

Dim srcsheet As Object
Dim dstsheet As Object
Dim functionaccess As Object

'http://api.openoffice.org/docs/common/ref/com/sun/star/sheet/SpreadsheetDocument.html
'http://api.openoffice.org/docs/common/ref/com/sun/star/sheet/XSpreadsheetDocument.html
'http://api.openoffice.org/docs/common/ref/com/sun/star/sheet/XSpreadsheets.html
'http://api.openoffice.org/docs/common/ref/com/sun/star/container/XNameAccess.html
'http://api.openoffice.org/docs/common/ref/com/sun/star/sheet/Spreadsheet.html
Set srcsheet = ThisComponent.getSheets().getByName("Sheet1")
Set dstsheet = ThisComponent.getSheets().getByName("Sheet2")

'http://api.openoffice.org/docs/common/ref/com/sun/star/sheet/FunctionAccess.html
functionaccess = createUNOService("com.sun.star.sheet.FunctionAccess")

n = 0
For i = 0 to 2
'http://api.openoffice.org/docs/common/ref/com/sun/star/sheet/Spreadsheet.html
'http://api.openoffice.org/docs/common/ref/com/sun/star/sheet/SheetCellRange.html
'http://api.openoffice.org/docs/common/ref/com/sun/star/table/CellRange.html
'http://api.openoffice.org/docs/common/ref/com/sun/star/table/XCellRange.html
'http://api.openoffice.org/docs/common/ref/com/sun/star/table/XCell.html
If srcsheet.getCellByPosition(1,i).getFormula() = "いぬ" Then
For j = 0 to 3
'FunctionAccessの使い方は他のサイトを参考にしました。配列の配列渡してもうまくいかないっぽかったので。
dstsheet.getCellByPosition(j,n).setFormula("=" & functionaccess.callFunction("ADDRESS",Array(i+1,j+1,1,1,"Sheet1"))
Next j
n = n + 1
End If
Next i
End Sub

'http://cid-b89cb784f5346675.office.live.com/browse.aspx/TestCase/Q6222502?uc=1
'面倒なので、汎用性とか全く確保してないが、(「SpreadSheetを引数にとった関数にすべき」とか、「jの値を0から3とか決め打ちすべきでない」とか、あと、個人的には、「文書にマクロをつけるんじゃなくて、マクロ自体を独立して配布できるようにしておきたい」とか)
'「基本的なスクリプト言語なら理解できます。」 って書いてあるので、
'その辺のコード弄りは質問者側でなんとかなるだろうと思ってます。新たにシートを追加するコードにしなくてもいいか