excel VBAの検索マクロを、OOo CALCで動かしたいのですが

質問

excel VBAの検索マクロを、OOo CALCで動かしたいのですが、、、

お助けください。VBA素人で、OOo BASICは全くわからない者です。よろしくおねがいします。

シート1を検索データの入力及び検索結果の表示画面として使い、
シート2に検索先のデータが入力されています。
検索先のデータは乱雑に入力されており、探したいデータが複数の列に点在し、
かつ、ひとつのセルにふたつのデータが入っていることもあります。

部分一致検索で、EXCELの検索機能の「次を検索」ボタンと同じ機能を果たすように作ったつもりです。
データが見つかった場合、シート2のデータをシート1にコピーするようになっています。

ソフトウェアのバージョンはcalc2.0と3.0です。
Excelでは動いているのですが、どう変えればcalcで使えるようになりますでしょうか？

---------------------------------------------
Sub kensaku()

'sheet1のC4に検索したいデータを入力済
Dim A
Set A = Range("sheet1!C4")
Dim B As Range

'シート2を選択。
Sheets("sheet2").Select

'A1:S800の範囲をAの値で検索。
Set B = Range("A1:S800").Find(What:=A, _
after:=ActiveCell, SearchDirection:=xlNext, _
LookAt:=xlPart, MatchCase:=False, _
MatchByte:=False, SearchFormat:=False)

'分岐
'見つからなかった場合、シート1の関数参照先のセルをクリアしてリセット。

If B Is Nothing Then
MsgBox "見つかりません"

Sheets("sheet1").Select
Range("C2").ClearContents

'見つかった場合、処理を続行する。

Else
B.Activate

'A列へ移動。場合により空白セルを超える必要があるため10回繰り返す。

Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select

'A列からC列へ移動すると目的のデータが入った列に到達。

Selection.Offset(0, 2).Select

'その値をコピーしてシート1のC2へ貼付(関数の参照先)

Selection.Copy
Sheets("sheet1").Select
Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'範囲選択を解除
Application.CutCopyMode = False

'sheet2のアクティブセルを次の検索開始位置（16列右）へ移動 (条件に一致する次のデータを検索するため)

Sheets("sheet2").Select
Selection.Offset(0, 16).Select

'シート1に戻る

Sheets("sheet1").Select

End If
End Sub

回答No.1

mt2008 · ベストアンサー

Calc 3用にしてみました。
そのまま移植ではなく、無駄な動きをしている箇所は勝手に直しています。
ご参考までに

Option VBASupport 1
Sub kensaku()

　'sheet1のC4に検索したいデータを入力済
　Dim A
　A =Sheets("Sheet1").Range("C4")

　Dim B
　'シート2を選択。
　Sheets("Sheet2").Select

　'A1:S800の範囲をAの値で検索。
　Set B = Range("A1:S800").Find(What:=A)

　'分岐
　'見つからなかった場合、シート1の関数参照先のセルをクリアしてリセット。
　if Isnull(B )=true Then
　　MsgBox "見つかりません"
　　Sheets("Sheet1").Range("C2")=""
　　Exit sub
　End if

　'見つかった場合、処理を続行する。
　'発見行C列の値をシート1のC2へ貼付
　Sheets("Sheet1").Range("C2")= Cells(B.Row,3)

　'sheet2のアクティブセルを次の検索開始位置（発見行のT列）へ移動 (条件に一致する次のデータを検索するため)？
　Sheets("Sheet2").Cells(B.Row, 20).Select

　'シート1に戻る
　Sheets("Sheet1").Select

End Sub

お礼

できました！
無駄な部分まで削っていただきまして、ホントに助かりました。
ありがとうございました！！