こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

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

投稿日時 - 2010-04-24 14:36:49

QNo.5848001

すぐに回答ほしいです

質問者が選んだベストアンサー

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

投稿日時 - 2010-04-26 11:02:36

お礼

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

投稿日時 - 2010-04-27 18:02:02

ANo.1

このQ&Aは役に立ちましたか?

1人が「このQ&Aが役に立った」と投票しています

回答(1)

あなたにオススメの質問