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
お礼
早速の回答をありがとうございました。 上手く行きました。