• ベストアンサー

VBScriptでfindを使うには??

ExcelのA列に日付がずらずらと入っているのですがその中から「今日」に該当する部分を探したいと思っています。 findを使うことが出来ないでいます。 Const xlValues = -4163 Set objExcelApp = CreateObject("Excel.Application") objExcelApp.Visible = True objExcelApp.Workbooks.Open("C:\Book1.xls") strLastDay = Cstr(Date - 1) With objExcelApp.WorkSheets("Sheet1").Rangge("A8:A65535") Set objClm = .Find(Trim(strLastDay),,xlValues) If Not objClm Is Nothing Then intCol = objClm.Column intRow = objClm.Row このあとどうしたらいいかわかりません・・・お願いします。

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

  • ベストアンサー
noname#102340
noname#102340
回答No.2

なぜFindが使えないのか詳しいことは分かりませんでしたがとりあえず動くようにはしました。 シートのB列とC列を書き換えているので注意してください。 Const xlValues = -4163 Set objExcelApp = CreateObject("Excel.Application") objExcelApp.Visible = True objExcelApp.Workbooks.Open ("C:\Book1.xls") Set ExcelSheet = objExcelApp.Worksheets("Sheet1") With ExcelSheet 'Cells(1, 2)に検索する日付を入力(Date?) .Cells(1, 2).Value = Date - 1 'Cells(1, 2)の値をTextプロパティで取得するので見た目を整えておく .Columns("A:A").EntireColumn.AutoFit .Columns("B:B").EntireColumn.AutoFit i = 8 '検索開始行 j = 1 'Cells(j, 3)に見つかった行を入力する On Error Resume Next Do Set rng = .Range("A" & i & ":A65535").Find(.Cells(1, 2).Text, , xlValues) .Cells(j, 3).Value = rng.Row j = j + 1 i = rng.Row + 1 Loop Until rng Is Nothing Or i > 65535 On Error GoTo 0 End With

その他の回答 (1)

  • myRange
  • ベストアンサー率71% (339/472)
回答No.1

>このあとどうしたらいいかわかりません・・・お願いします。 このあとしたいことは、質問者にしか分かりません。(^^;;; それ以前に提示したコードはいくつかミスがあるので動作しません。 で、次のコードを試してみてください。 エクセルA列の日付の表示形式が、2009/9/5(YYYY/M/D) として。 '---------------------------------------------- Const xlValues = -4163 Set objExcelApp = CreateObject("Excel.Application") objExcelApp.Visible = True Set myBook = objExcelApp.Workbooks.Open("C:\Book1.xls") strLastDay = Date With myBook.WorkSheets("Sheet1").Range("A8:A65535") Set objClm = .Find(strLastDay,,xlValues) End with If Not objClm Is Nothing Then   intCol = objClm.Column   intRow = objClm.Row   MsgBox "今日は、" & objClm.Address(0,0) & " のセルです" End If '------------------------------------------ 最も重要なところは Set myBook = objExcelApp.Workbooks.Open("C:\Book1.xls") With myBook.WorkSheets("Sheet1").Range("A8:A65535") これです。 また、今日を探すわけですから >strLastDay = Cstr(Date - 1)   Dateから1引く必要はないし、 >Set objClm = .Find(Trim(strLastDay),,xlValues)   Trimも不必要だと思いますが。 以上です。

関連するQ&A

  • VBScript Excel Workbooks

    全く下らない質問で申し訳ございません。 あくまでも、興味があったので質問しているだけで、 以下のやり方でなくても、やりたいことが実現できることは 分かっているのですが、教えて頂ければ幸いです。 VBScriptで Option Explicit Dim x, y Set x = CreateObject("Excel.Application") Set y = x.Workbooks.Open("D:\Sample.xlsx").Worksheets(1) | x.Workbooks(1).Close x.Quit Set y = Nothing Set x = Nothing 普通は、 Set y = x.Workbooks.Open("D:\Sample.xlsx") Set z = y.Worksheets(1) として、 y.Close とする方が分かりやすいのは分かっているのですが、 あえて、勉強を兼ねて、上記のように記述しました。 私が知りたい疑問は、Excelのファイルを2つ開いた場合です。 Option Explicit Dim x, y, z Set x = CreateObject("Excel.Application") x.Application.DisplayAlerts = False x.Visible = False Set y = x.Workbooks.Open("F:\Sample.xlsx").Worksheets(1) Set z = x.Workbooks.Add().Worksheets(1) z.Range("A1").Value = y.Range("A1").Value x.Workbooks(1).Close x.Workbooks(2).SaveAs("F:\Test_02.xlsx") x.Workbooks(2).Close x.Quit Set z = Nothing Set y = Nothing Set x = Nothing このプログラムで、 Set y = x.Workbooks.Open("F:\Sample.xlsx").Worksheets(1) の行が無ければ、「x.Workbooks(1).Close」もなく、 その下の行は、 x.Workbooks(1).SaveAs("F:\Test_02.xlsx") x.Workbooks(1).Close となり、問題なく「Test_02.xlsx」ファイルが出来ていました。 ファイルを2つ開いたので、「Workbooks(2)」となる、 と思ったのですが、どうやら違うようです。 (「インデックスが有効範囲にありません」というエラーになります) 何度も言いますが、こんなことで悩む必要がないのは 分かっているのですが、何か気になります。 上記のやり方で、Excelのファイルを2つ開いている場合の 2つ目のファイルを閉じる方法を教えてください。 ホント、下らない質問で申し訳ございませんが よろしくお願い致します。 以上

  • vbs 文字位置を中央に

    vbscriptでエクセルファイルへ出力するスクリプトを作成しています。 エクセルファイルのセルに文字列を入力し、文字を中央揃えにしたいのですが、うまくいきません。 ----------------------------------------- Dim FSO, objExcel, objBook, objSheet Set FSO = CreateObject("Scripting.FileSystemObject") Set objExcel = CreateObject("Excel.Application") objExcel.Visible = True Set objBook = objExcel.Workbooks.Add Set objSheet = objExcel.Worksheets("Sheet1") objSheet.range("a1") = "test" objSheet.range("a1").HorizontalAlignment = xlHAlignCenter Set FSO = Nothing : objExcel = Nothing : Set objBook = Nothing : Set objSheet = Nothing ----------------------------------------- どうすれば、中央揃えにできますでしょうか? よろしくおねがいします。

  • ASP(VBScript)にてExcelアプリケーションが終了しない

    こんばんは VBScriptでExcelを読込みサーバのDBに内容を登録後に終了をしているのですがサーバにExcelアプリケーションが残ったままになっています。 strGetFileName = "C:\a.xls" 'Excelシート設定 Set xlsApp = Server.CreateObject("Excel.Application") xlsApp.Workbooks.Open strGetFileName Set xlsBook = xlsApp.Workbooks(1) Set xlsSheet = xlsBook.Worksheets(2) ← 二枚目のシート --中略-- xlsSheet.Application.Quit 'Excelアプリケーションのメモリ開放 Set xlsSheet = Nothing Set xlsBook = Nothing Set xlsApp = Nothing といったコーディングなのですが処理を重ねるたびにタスクマネージャに Excelアプリケーションが残り、重くなってしまいます。 終了の方法が悪いのではないかとは思いますが、実現方法がわかりません。 オブジェクトをオープンしているのでクローズ命令でも試してみましたがうまくいきませんでした。 どなたかご存知の方いらっしゃいましたら教えてください。 OS Win2000 ASP,BASP 言語 Html,VBScript,JavaScript

  • Findを使用して、データが入力されているセルのみを検索

     | A | ------- 1| 123 | 2|    | 3| 456 | 4| 789 | Excel2003を使用しています。 上記のデータをFindを使用して、データが入力されているセルのみを検索したく、 Set C = Worksheets(AAA).Range("A:A").Find(<>"", LookIn:=xlValues) など、試してみたのですが、上手くいきません。 『Findを使用して、データが入力されているセルのみを検索』する事じたいが無理なのでしょうか。  ご教授の程、お願いします。

  • エクセルVBAのFINDの質問です。

    エクセルVBAのFINDの質問です。 シート1    A    B    C     D 1 コード1 コード2 コード3 名 称 2  4    1     1 3  4    2     2 4  4    3     1 シート2    A    B 1 コード1 名 称 2  1   名称1 3  2   名称2 やりたいことは、シート1のD列に、シート1のコード3をもとにシート2から名称を取得したいのです。 下記に記したプログラムだと最初のFINDNEXTは動くのですが、 2回目でエラーになってしまい、次を読んでくれません。 どなたか、ご教授頂けますでしょうか。 シート1の検索条件はコード1の"4"です。 シート1のコード1は重複キーで、一レコードずつ読んで行き、各レコード毎にシート2を読みたい のです。 Dim シート1 As Worksheet Dim シート2 As Worksheet Dim obj As Object Dim Lin As Integer Dim mykey As Integer Dim obj1 As Object Dim Lin1 As Integer Dim mykey1 As Integer Dim st_Lin As Integer Set シート1 = ThisWorkbook.Worksheets("シート1") Lin = シート1.Cells(シート1.Rows.Count, 1).End(xlUp).Row mykey = "4" Set obj = シート1.Range("A1", "A" & Lin).Cells.Find(What:=mykey, _ LookIn:=xlValues, _ lookat:=xlWhole, _ SearchOrder:=xlByColumns) If obj Is Nothing Then   MsgBox ("異常です")   Exit Sub Else   st_Lin = obj.Row   Do Until obj.Row <> st_Lin    Set obj = シート1.Range("A1", "A" & Lin).FindNext(obj)    If obj Is Nothing Then     Exit Do    Else     Set シート2 = ThisWorkbook.Worksheets("シート2")       With シート2          Lin1 = .Cells(シート2.Rows.Count, 1).End(xlUp).Row          mykey1 = シート1.Cells(obj.Row, 3).Value          Set obj1 = .Range("A1", "A" & Lin1).Cells.Find          (What:=mykey1,LookIn:=xlValues,lookat:=xlWhole,SearchOrder:=xlByColumns)          If obj1 Is Nothing Then           MsgBox ("名称取得できませんでした")           Exit Sub          Else            シート1.Cells(obj.Row, 4).Value = .Cells(obj1.Row, 2).Value          End If       End With    End If   Loop End If

  • VBscriptでEXCELを起動

    今、非常に悩んでいる問題があります。 VBscriptでEXCELを起動したいのですがうまく行きません。 (Web画面であるボタンを押下すると、Webサーバ上のEXCELが開くというものです) プログラム的には (1) Dim excel Set excel = GetObject("", "Excel.Application") excel.Visible = True excel.Workbooks.Open "http://ホスト名/フォルダ名/ファイル名.xls" Set WK_excel = Nothing (2) Dim excel Set excel = CreateObject("Excel.Application") excel.Visible = True excel.Workbooks.Open "http://ホスト名/フォルダ名/ファイル名.xls" Set WK_excel = Nothing の二通り(他いろいろ)を試したのですが、何もおきずに終了します。 同じことをVB6.0でするとうまく行くのですが・・・ はっきり言うとVBscriptに関して知識がなく 質問内容も説明が分かりにくいかもしれませんが よろしくお願いいたします。

  • SETを使ったほうがよい?

    accwessからエクセルファイルを開きたいのですが、 App.Workbooks.Open と、 Set xlBook = xlApp.Workbooks.Open とどちらを使った方がいいのでしょうか? ////////////////////////////////////////////////////////// Private Sub ファイル1_Click() Dim App As Object Dim MyFileName As String MyFileName = "D:\My Documents\test.xls" Set App = CreateObject("Excel.Application") App.Workbooks.Open FileName:=MyFileName App.Visible = True End Sub でも Private Sub ファイル2_Click() Dim xlApp As Object Dim xlBook As Object Dim FileName As String Const FolderName = "D:\My Documents\test.xls" Set xlApp = CreateObject("Excel.Application") Set xlBook = xlApp.Workbooks.Open(FolderName & FileName) xlApp.Visible = True Set xlApp = Nothing Set xlBook = Nothing End Sub ////////////////////////////////////////////////////////// でも開けました。 多分、SETを使うかどうかの違いだと思うのですが VBAでコードを作る際、どちらのコードを使った方がいいか教えてください。

  • Excel2000で、特定のシートを新規ブックに保存したい

    マクロ実行中のブックの特定のシートを新規ブックに保存したいのです。 特定のシートは、任意で複数枚あるとします。 但し、クリップボードや、Activeメソッド、Selectメソッドなど、 マクロ実行中に、Windowsの他のアプリケーションに 影響の出る恐れがあるロジックは使用しないとします。 また、特定のシートには、罫線や色の設定なども してあり、新規ブックに書式も保存します。 以下のコードは、クリップボードを経由せず、セルをコピーしています。 Sub a() Dim xlsApp As Excel.Application Dim xlsBook As Excel.Workbook Dim xlsSheet As Excel.Worksheet Set xlsApp = CreateObject("Excel.Application") Set xlsBook = Workbooks.Add  '★1 Set xlsSheet = xlsBook.Worksheets(1) '★2 ThisWorkbook.Worksheets("Sheet1").Range("A1:D200").Copy _ Destination:=xlsBook.Worksheets("Sheet1").Range("A1:D200") xlsBook.Close xlsApp.Quit Set xlsApp = Nothing Set xlsBook = Nothing Set xlsSheet = Nothing End Sub このコードは、ちゃんと動きます。 しかし、問題があります。 xlsApp.ScreenUpdating = False xlsApp.Visible = False など上記のコードに追加すると、新規ブックの操作できません。 ★1の部分で、 Set xlsBook = Workbooks.Add  としているからです Set xlsBook = xksApp.Workbooks.Add  とすると、 xlsApp.ScreenUpdating = False xlsApp.Visible = False など、新規ブックの操作ができます。 しかし、 Set xlsBook = xksApp.Workbooks.Add  では ★2の ThisWorkbook.Worksheets("Sheet1").Range("A1:D200").Copy _ Destination:=xlsBook.Worksheets("Sheet1").Range("A1:D200") で、「RangeクラスのCopyメソッドが失敗しました。」 とエラーが発生します。 何か良い方法はありますか?

  • Find2重使用後のFindNextの使用について

    Excel2003にて シート2に記載されている表のD列の中からFindを使用し、条件に該当するものを検索した後、該当する行のE列の値を取り出し、それを条件にしてシート3のL列をFindを使用し検索する。次に該当した行のQ列の値を取り出し、シート2のH列に記載するといった感じの内容をFindNextを使い繰り返すVBAを組んでいるのですが、FindNextを使用した際に検索結果がNothingになってしまいます。Findを2回使用しているのが原因なんでしょうかね?なにか有効な対策方法はないでしょうか?ご教授願います。 <イメージ> 検索条件1:2-1 (シート2)   D   E     H 1 2-1 田中   兵庫  ← H列にシート3で検索した住所を記載させたい。 2 2-2 吉田 3 2-3 山田 4 2-1 田上 検索条件2:(シート2で2-1の条件で検索された)田中 (シート3)    L   Q 1 吉田 大阪 2 田中 兵庫 3 田上 大阪 4 山田 奈良 <コード> Sub add() Dim class(1 To 10) As String class(1) = "2-1" class(2) = "2-2" class(3) = "end" i = 1 Do Until class(i) = "end" Set objFind = Worksheets(2).Columns("D").Find(class(i), LookIn:=xlValues) If Not objFind Is Nothing Then Do Until oldaddress > objFind.Row class_sh2_YLine = objFind.Row class_nm = Cells(class_sh2_YLine, "E") Set objFind2 = Worksheets(3).Columns("L").Find(class_nm, LookIn:=xlValues) If Not objFind2 Is Nothing Then class_sh3_YLine = objFind2.Row class_add = Worksheets(3).Range("Q" & class_sh3_YLine) Worksheets(3).Rows(class_sh3_YLine).Delete Worksheets(2).Cells(class_sh2_YLine, "H") = class_add Else MsgBox "該当する住所がありません" End If oldaddress = objFind.Row Set objFind = Worksheets(2).Range("D:D").FindNext(objFind) Loop End If i = i + 1 Loop End Sub

  • Findステートメントで別なブックの検索

    Findステートメントで検索した内容のある行のA列にある値をキーワードとして別なブックのA列に検索をかけてヒットしたセルの内容を元のブックの指定したセルに移すという動作をさせたいので次ののように書いてみました。 Private Sub CommandButton2_Click() Dim Yline As Long Dim No As Variant Dim c As Range Dim sh As Worksheet Dim sh_no As Integer Dim findcell As Range Dim add As String Set sh = Worksheets("ブックAの1") No = TextBox1.Text sh_no = 1 'テキストボックスに値が入っていた場合 If No <> "" Then 'Find メソッドの最低のプロパティは入れる。SearchOrder は特にいらない Set c = sh.Range("B:B").Find( _ What:=No, _ LookIn:=xlValues, _ LookAt:=xlPart, _ Searchorder:=xlByRows) '見つかった場合にのみ、値を入れる If Not c Is Nothing Then Yline = c.Row '見つかった行のA列の文字列でブックBに検索をかける add = sh.Cells(Yline, 1).Value Workbooks("B").Activate Set findcell = Workbooks("B").Worksheet(sh_no).Range("A:A").Find( _ What:=add, _ LookIn:=xlValues, _ LookAt:=xlPart, _ Searchorder:=xlByRows) '前Setステートメントからのループ検索開始 If findcell Is Nothing Then Do sh_no = sh_no + 1 If sh_no > ThisWorkbook.Worksheets.Count Then Exit Sub End If Set findcell = Workbooks("B").Worksheets.(sh_no).Range("A:A").Find( _ What:=add, _ LookIn:=xlValues, _ LookAt:=xlPart, _ Searchorder:=xlByRows) Loop While findcell Is Nothing End If End If Workbooks("A").Activate With Worksheets("Aの2")   .Cells(21, 4).Value = sh.Cells(Yline, 14).Value .Cells(20, 4).Value = sh.Cells(Yline, 15).Value .Cells(36, 4).Value = findcell End With Unload Me Else MsgBox No & " は見つかりません。", 48 End If Set sh = Nothing End Sub するとwhat:=addとしてaddが見つかるまでシート番号を増やしていくループのところでエラーがでてキーワードが見つからないと出ます。恐らくブックBを検索してくれているとは思うのです。A列に空白があるためかと思い埋めてみましたが関係ないようです。 構文エラー的なものは無いと思いますが、宜しくお願いします。