- 締切済み
Textboxに入力してBookを開く
keirikaの回答
- keirika
- ベストアンサー率42% (279/658)
テキストボックスに入力された文字列から同一フォルダ内にある エクセルファイルを開くと言うことなので テキストボックスのKeyDownイベントを使用し、文字を入力後 ENTERを押した時点で動作する記述を考えてみました。 Private Sub Text1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If KeyCode = 13 Then On Error GoTo Err_Syori Workbooks.Open (ThisWorkbook.Path & "\" & Text1) End If Exit Sub Err_Syori: MsgBox "指定された名前のブックはありません。" End Sub
関連するQ&A
- Excelのブック間の串刺し計算について
Excelのブック間の串刺し計算について VBA超初心者です。同じフォルダ内にファイルがいくつかあり、同じ形式で、sheet1のB4のセルに計があったとして、それをブック間で串刺し集計したいのですが、うまくいきません。どこが悪いのかもわからず、困り果ててます。ご指導お願いします。 Sub BookShuukei() Dim FileName As String Dim Total As Integer Dim OpenedBook As Workbook Dim IsBookOpen As Boolean FileName = Dir("*.xls") Application.ScreenUpdating = False Do While FileName <> "" If FileName <> ThisWorkbook.Name Then IsBookOpen = False For Each OpenedBook In Workbooks If OpenedBook.Name = FileName Then IsBookOpen = True Exit For End If Next If IsBookOpen = False Then Workbooks.Open (FileName) End If Total = Total + Workbooks(FileName).Sheets(1).Range("B4").Value If IsBookOpen = False Then Workbooks(FileName).Close End If End If FileName = Dir() Loop Application.ScreenUpdating = True MsgBox (Total) End Sub
- 締切済み
- オフィス系ソフト
- 複数のブックの特定シートを1つのブックにまとめたい
複数のブックの特定のシートを1つのブックにまとめたいのですが そのマクロは下記のように検索してでてきたのですが Sub test() Dim Fname As String Dim Wbm As Workbook Dim Wbs As Workbook Application.ScreenUpdating = False Set Wbs = ThisWorkbook Fname = Dir(ThisWorkbook.Path & "\*.xlsx*") Do While Fname <> "" If Fname <> ThisWorkbook.Name Then Workbooks.Open ThisWorkbook.Path & "\" & Fname Set Wbm = ActiveWorkbook Wbm.Worksheets("2016.03").Copy after:=Wbs.Worksheets(Wbs.Worksheets.Count) ActiveSheet.Name = Left(Fname, InStr(Fname, ".") - 1) Wbm.Close End If Fname = Dir() Loop Application.ScreenUpdating = True End Sub たとえば、特定のシートというのが毎回変わる場合今回は”2016.03"ですが 次回は”2016.04”という風に変わる時、どこかに入力したセルの値を元にシートを検索してくることなどは可能なのでしょうか？ よろしくお願い致します。
- ベストアンサー
- Visual Basic
- ブックの集計方法について
複数ファイルにある特定のシートのA列に記載がある時だけ、その行のA列からJ列までを、一つのファイルにコピーしたいと思っています。 ネットで調べてみたところ、エクセルで複数ファイルにある特定のシートの 特定した範囲を一つのファイルにコピーするマクロを探すことができました。 複数のシートから特定のシートのA列に文字がある場合は、J列までを一つのファイルの同じシートにコピーするようなことは出来ないでしょうか？ （例えば、各ブックA列に10行ずつ文字がある場合は、このようなとりまとめをできないかと考えています。） ブック１（シート名：Q2）⇒集計シートのA１：J１０ ブック２（シート名：Q2）⇒集計シートのA１１：J２０ ブック３（シート名：Q2）⇒集計シートのA２１：J３０ Sub ブック集合() Dim FileName As String Dim c As Integer Dim OpenedBook As Workbook Dim IsBookOpen As Boolean ChDir "c:/test" FileName = Dir("*.xls") Application.ScreenUpdating = False Application.DisplayAlerts = False c = 0 Do While FileName <> "" If FileName <> ThisWorkbook.Name Then IsBookOpen = False For Each OpenedBook In Workbooks If OpenedBook.Name = FileName Then IsBookOpen = True Exit For End If Next If IsBookOpen = False Then Workbooks.Open (FileName) End If Workbooks(FileName).Sheets("Q2").Range("A1:J500 ").Copy _ ThisWorkbook.Sheets(3).Cells(c * 500 + 1, 1).PasteSpecial(xlPasteValues) c = c + 1 If IsBookOpen = False Then Workbooks(FileName).Close End If End If FileName = Dir() Loop Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub
- ベストアンサー
- オフィス系ソフト
- エクセルのVBAに関する質問です。
エクセルのVBAに関する質問です。 「指定フォルダ（ここではXXXX）内の全てのエクセルファイルを開き、内容を転記していく」 というマクロについての質問です。 ネットを参照し、以下のマクロを見つけました。 -------------------------------------------------------------------------- Sub Macro1() Dim theName As String Dim theDir As String Dim theBook As Workbook Dim flg As Boolean flg = True Application.ScreenUpdating = False theDir = ThisWorkbook.Path & "\XXXX" theName = Dir(theDir & "\*.xls") Do While theName <> "" Set theBook = Workbooks.Open(theDir & "\" & theName) Call subA(theBook, flg) flg = False theBook.Close theName = Dir Loop End Sub Sub subA(theBook As Workbook, flg As Boolean) Dim thetbl As Range, LRow As Long Set thetbl = theBook.Sheets(1).Range("A1").CurrentRegion thetbl.Copy With ThisWorkbook.ActiveSheet LRow = .Range("A65536").End(xlUp).Row If LRow = 1 Then .Range("A" & LRow).PasteSpecial xlPasteValues Else .Range("A" & LRow + 1).PasteSpecial xlPasteValues End If End With Application.CutCopyMode = False End Sub -------------------------------------------------------------------------- 実際にはこのマクロは上手く動作していますが、１つ疑問があります。 「一度開いたファイルは開かない」というのはどの部分のおかげか、ということです。 当方初心者で、分かりづらい質問かもしれませんが、どうぞご教授お願いいたします。
- ベストアンサー
- Visual Basic
- 素数を求めるマクロを
走らすと暴走したようになり、素数＝１５１で止まります。 どこが悪いのでしょうか。正常に終わるようにしたいです。 ====================== Sub 素数を求める() Dim i As Long Dim j As Long Dim m As Long Dim p As Long Dim flg As Boolean i = 1 j = 1 p = 2 Do flg = False For m = 2 To Int(Sqr(p)) If p Mod m = 0 Then flg = True Exit For End If Next If flg = False Then Cells(i, j) = p i = i + 1 If i > Rows.Count Then i = 1 j = j + 1 End If End If p = p + 1 Loop End Sub ======================
- 締切済み
- Excel（エクセル）
- VBAを実行するとエクセルが落ちる
同一フォルダ内にあるCSVデータを一つのエクセルにワークブックにまとめるため CSVデータを開いて、各シートに値を貼り付けるVBAを作成しました デバックモードで1行毎に実行するとエクセルが落ちることはありませんが 普通に実行するとエクセルが閉じてしまいます 原因が分からないためご指摘いただけると幸いです Win7のOffice2013です。 Sub contents() Sheets("01").Select Sheets("01").Cells.Select Selection.ClearContents Dim ShA As Worksheet Dim FileA As String Set ShA = ThisWorkbook.Sheets("01") ChDir "C:\Users\Public\Documents" FileA = "C:\Users\Public\Documents\01.csv" If FileA <> "False" Then Workbooks.OpenText Filename:=FileA, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlTextQualifierNone, Comma:=True ActiveSheet.Cells.CurrentRegion.Copy Destination:=ShA.Range("A1") ActiveWorkbook.Close False End If Set ShA = Nothing Sheets("02").Select Sheets("02").Cells.Select Selection.ClearContents Dim ShB As Worksheet Dim FileB As String Set ShB = ThisWorkbook.Sheets("02") ChDir "C:\Users\Public\Documents" FileB = "C:\Users\Public\Documents\02.csv" If FileB <> "False" Then Workbooks.OpenText Filename:=FileB, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlTextQualifierNone, Comma:=True ActiveSheet.Cells.CurrentRegion.Copy Destination:=ShB.Range("A1") ActiveWorkbook.Close False End If Set ShB = Nothing Sheets("03").Select Sheets("03").Cells.Select Selection.ClearContents Dim ShC As Worksheet Dim FileC As String Set ShC = ThisWorkbook.Sheets("03") ChDir "C:\Users\Public\Documents" FileC = "C:\Users\Public\Documents\03.csv" If FileC <> "False" Then Workbooks.OpenText Filename:=FileC, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlTextQualifierNone, Comma:=True ActiveSheet.Cells.CurrentRegion.Copy Destination:=ShC.Range("A1") ActiveWorkbook.Close False End If Set ShC = Nothing End Sub
- ベストアンサー
- Excel（エクセル）
- エクセルのブックを閉じるマクロについて
エクセルのブックＡとブックＢが開いている状態で、 ブックＡのボタンに登録して実行すると、ブックＡのみ閉じる、 というマクロを作りました。（下部にコードを記載します） このマクロは、２つのブックが開いていると正常に稼働するのですが、 ブックが１つしかない場合、実行時エラーが出てしまいます。 （ブックＡのみ開いた状態でこのボタンを押してもエラーなく閉じたい） 実行時エラーが出ないようにするにはどうすれば良いか、 おわかりの方がいらっしゃいましたら教えて下さい。 どうぞよろしくお願い致します。 Sub このブックのみ閉じる() Dim wa As String wa = "ほかに無い" Dim wb As Workbook For Each wb In Workbooks If wb.Name <> ThisWorkbook.Name Then wa = "ほかにあるよ" End If Next If wa = "ほかに無い" Then Application.DisplayAlerts = False Application.Quit '終了予定 End If Range("D2").Select Selection.ClearContents ThisWorkbook.Close SaveChanges:=False End Sub
- ベストアンサー
- Excel（エクセル）
- Activeブック以外の開いているブックを閉じたい
複数のbookが開いている状態で、 Activebook以外のworkbookを閉じたいです。 book名、book数は一定ではありません。 こんなことをしてみたのですが動かないです。 何かよい方法はないでしょうか。 Dim hbook As Object 名前 = ActiveWorkbook.Name For Each hbook In Workbooks If hbook.Name <> 名前 Then Workbooks(hbook & ".xls").Close ' False End If Next
- ベストアンサー
- オフィス系ソフト
- 特定の文字以外を入力すると別シートに表記する方法
Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim StrRow As Long Dim TgtCol As Long Dim MaxRow As Long Dim ChgRow As Long Dim PutSh1 As Worksheet Dim PutSh2 As Worksheet Dim PutSh3 As Worksheet Dim PutCol As Long Dim PutRow As Long Dim ChgRng1 As Range Dim ChgRng2 As Range Dim ChgRng3 As Range StrRow = 5 MaxRow = 35 If Target.Count > 1 Then Exit Sub If Target.Value = "" Then Exit Sub Set PutSh1 = ThisWorkbook.Sheets("Sheet2") Set PutSh2 = ThisWorkbook.Sheets("Sheet3") Set PutSh3 = ThisWorkbook.Sheets("Sheet4") With ThisWorkbook.Sheets("Sheet1") Set ChgRng1 = Range(.Cells(StrRow, 3), .Cells(MaxRow, 3)) 'C列 Set ChgRng2 = Range(.Cells(StrRow, 5), .Cells(MaxRow, 5)) 'E列 Set ChgRng3 = Range(.Cells(StrRow, 7), .Cells(MaxRow, 7)) 'G列 End With ChgRow = Target.Row If Not Intersect(Target, ChgRng1) Is Nothing Then Target.Offset(0, -1).Value = Target.Offset(0, -1).Value + 1 DataPut PutSh1, ChgRow, Target.Value End If If Not Intersect(Target, ChgRng2) Is Nothing Then Target.Offset(0, -1).Value = Target.Offset(0, -1).Value + 1 DataPut PutSh2, ChgRow, Target.Value End If If Not Intersect(Target, ChgRng3) Is Nothing Then Target.Offset(0, -1).Value = Target.Offset(0, -1).Value + 1 DataPut PutSh3, ChgRow, Target.Value End If End Sub 以前質問させて頂いた内容で追加の質問です。 Sheet1の指定したセルに「ー（ハイフン）」の文字がある時は、Sheet2〜4に転送（表記）しない方法を追加する場合はどの様にすれば宜しいでしょうか？
- ベストアンサー
- Excel（エクセル）
- ブック全体の検索の次へは？
ブック全体を検索するマクロ作ったのですが、 ブックの最初にあるものしか見つけられません。 見つかった時に、次の検索を行うにはどのようなＶＢＡになるのでしょうか？ よろしくお願いもうしあげます。 Sub KensakuAll() 'ブック内の全シートを検索 Dim myWb As Workbook Dim mySht As Worksheet Dim myRng As Range Dim Key1 As String Key1 = InputBox("検索キーを入力しなさい") If Key1 = "" Then Exit Sub For Each mySht In Sheets Set myRng = mySht.Cells.Find(what:=Key1) If Not myRng Is Nothing Then mySht.Activate myRng.Activate Set mySht = Nothing Set myRng = Nothing Exit Sub End If Next MsgBox "該当するセルは見つかりませんでした" Set mySht = Nothing Set myRng = Nothing End Sub
- ベストアンサー
- オフィス系ソフト
補足
早速のアドバイスありがとうございます。 Text1_boxに"keirikaさん"のコードをコピーして試してみましたが 動作しませんでした。 最初に考えていたのは Textboxに入力コマンドボタン（Caption;OK)のクリックイベントで実行 というイメージでした。 また、これが動作したらもう一つとしてコンボboxを配置して シート内にBook名一覧をつくり それをコンボBoxに反映して 開きたいBook名をクリックしたらTextboxにBook名が反映し コマンドボタンをクリックすると、"実行"という動作をしたいと思っています。 まず、動作しなかったのはコピーの場所がいけなかったのか すべてのBookがActiveではなかったからでしょうか？ Bookはすべて閉じられた状態で指定したBookだけを開きたいのですが。 よろしくお願いします。