- ベストアンサー
VBAコードでシート名を取得する方法
piroin654の回答
- piroin654
- ベストアンサー率75% (692/917)
UserFormにボタンとコンボボックスを設定し、ボタンの クリックイベントに以下を設定します。 Private Sub CommandButton1_Click() Dim wkb As Workbook Dim wks As Worksheet Dim strFileName As String strFileName = "テストファイル.xlsm" Set wkb = Workbooks.Open(ThisWorkbook.Path & "\" & strFileName, , True) With ComboBox1 For Each wks In wkb.Worksheets .AddItem wks.Name Next End With wkb.Close Set wks = Nothing Set wkb = Nothing End Sub 続いて、UserFormに二個目のボタンを設定し、 質問のSub CommandButton1()の中身を設定 します。 設定したら、 Set LstWs = LstWb.Sheets("Sheet1") のところを、 If ComboBox1.Text = "" Then MsgBox "コンボボックにデータが表示されていません" Exit Sub Else MsgBox ComboBox1.Text Set LstWs = LstWb.Sheets(ComboBox1.Text) End If に置き換えます。 あと、質問のコードの中でファイルを開くとき、 ReadOnlyにするのか、とか、開いたファイルは 最後に閉じておくとか、オブジェクトの破棄を しておくとか、いろいろあるようですが、 とりあえずこれで試してみてください。
関連するQ&A
- ＶＢＡ 任意のシートからコピーを始める。
教えてください。 全てのシートをコピーして一つのシートにまとめるプログラムシートを作成しました。 1番目のシートからコピーを始める場合は For i = 2 To Worksheets.Count 2番目のシートからコピーを始める場合は For i = 3 To Worksheets.Count とすればよいのですがこれだといちいちモジュールコードを出して数字を変更しなければならず面倒です。 そこでユーザーフォームのコンボボックスに任意の数字を入れてクリックを押せば希望するシートからコピーを始めるプログラムを作成してみましたがうまくいきません。どなたか教えてくださいませんか。 Sub matome() Dim i As Integer Dim lRow As Long, lCol As Long, lRow2 As Long, lRow3 As Long, SNo As Integer '----何番目からコピーを始めるかを決定します With UserForm2 SNo = .ComboBox1.value End With For i = 1 + SNo To Worksheets.Count With Worksheets(i) lRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1 lCol = .Cells(1, Columns.Count).End(xlToLeft).Column '----シートのデータが2行以上の場合にコピーします If lRow >= 2 Then lRow2 = Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1 If lRow2 < Worksheets(1).Cells(Rows.Count, 5).End(xlUp).Row + 1 Then lRow2 = Worksheets(1).Cells(Rows.Count, 5).End(xlUp).Row + 1 .Activate .Range(Cells(2, 1), Cells(lRow, lCol)).Copy Worksheets(1).Cells(lRow2, 1) End If End With Next i
- ベストアンサー
- Visual Basic
- 決まったシートだけコピーして一つのシートにまとめる
お世話になります。 http://okwave.jp/qa/q8216220.html で質問させていただいたVBAをこねくり回してみたのですが、「インデックスが有効範囲にありません」というエラーがでて進まなくなってしまいました。 Sub 特定のシートだけコピーと貼り付け() Dim k As Long, endRow As Long, wS As Worksheet Dim P As Variant P = Array("全", , "A", "B", "C", "D", "E", "F", "G", "H", "I") '↑コピーしたいシート名一覧 Set wS = Worksheets("まとめ") endRow = wS.cells(Rows.Count, "B").End(xlUp).Row If endRow > 4 Then Range(wS.cells(5, "B"), wS.cells(endRow, "M")).ClearContents End If For k = LBound(P) To UBound(P) ☆If Worksheets(k).Name <> "まとめ" Then 'ワークシート名が"まとめ"のとき endRow = Worksheets(P).cells(Rows.Count, "B").End(xlUp).Row 'P＝Arrayで指定しているシートのセルで If endRow > 4 Then '4行目より下を Range(Worksheets(P).cells(5, "B"), Worksheets(P).cells(endRow, "M")).Copy _ wS.cells(Rows.Count, "B").End(xlUp).Offset(1) 'B5からM列の任意のデータが入っているセルまでコピーして"まとめ"シートに貼り付け End If '繰り返す End If '繰り返す Next k '次のシートへ End Sub 自分で分かるようにコメントを付けています。 ☆のついているところで、「インデックスが有効範囲にありません」と出ます。 指定したシートに"まとめ"を追加してみてもやはり同じでした。 調べたところ、「インデックスが～」というのはVBA中の範囲にないものを指定しているからだ、ということなのですが・・・。 お知恵を貸して下さい。よろしくお願いします。
- ベストアンサー
- その他MS Office製品
- VBAで最終行の取得について
UserFormのConboBoxで「○○」を選んで、 UserFormのTextBoxで『あいう』と入力すると、ワークシートに A B 1 ○○ ×× 2 あいう と表示され、 UserFormのConboBoxで「××」を選んで、 UserFormのTextBoxで『アイウ』と入力すると A B 1 ○○ ×× 2 あいう アイウ 3 : : と表示されるようにしたいと思います。 以下のプログラムまではできています。 ********************************************* Private Sub UserForm_Initialize() Dim lasClm As Integer, i As Integer lasClm = Sheet1.Range("A1").End(xlToRight).Column For i = 1 To lasClm ComboBox1.AddItem Sheet1.Cells(1, i).Value Next i End Sub ********************************************* Private Sub CommandButton1_Click() Select Case ComboBox1.Text Case Sheet1.Cells(1, 1).Value '「○○」が選択 Sheet1.Cells(2, 1).Value = TextBox1.Text ・・・(1) Case Sheet1.Cells(1, 2).Value '「××」が選択 Sheet1.Cells(2, 2).Value = TextBox1.Text ・・・(2) End Select UserForm1.Hide End Sub ********************************************** 今は(1)、(2)のように直接セルを指定しているのですが、 この部分を各列（A列、B列）の最終行の値を取得して、 最終行＋１のセルに順次TextBoxに入力された値を代入していきたいのですが、 どのようにしたらよいのでしょうか。 しかし、A列とB列は同じように値が増えていくとは限りません。 例） A B 1 ○○ ×× 2 あいう アイウ 3 かきく 4 さしす となる場合もあるので、A列とB列それぞれの最終行の値を取得したいと思っています。
- ベストアンサー
- Visual Basic
- セルの選択について
<Sheet2のコード> Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not UserForm3.Visible Then UserForm3.Show 0 UserForm3.TextBox1.Text = Selection.Count End Sub *********************************************** <UserForm3のコード> Private Sub CommandButton1_Click() With Selection .MergeCells = True .WrapText = True .Value = TextBox2.Text & ComboBox1.Text End With UserForm3.Hide End Sub ---------------------------------------------- Private Sub UserForm_Initialize() Dim lastrw As Integer, lastrw2 As Integer, i As Integer lastrw = Sheet3.Range("A1").End(xlDown).Row lastrw2 = Sheet3.Range("B1").End(xlDown).Row If Sheet2.Range(Cells(5, 4), Cells(5, 100)).Select Then ・・・(1) For i = 1 To lastrw - 1 ComboBox1.AddItem Sheet3.Cells(i + 1, 1).Value Next i End If If Sheet2.Range(Cells(6, 4), Cells(6, 100)).Select Then ・・・(2) For i = 1 To lastrw2 - 1 ComboBox1.AddItem Sheet3.Cells(i + 1, 2).Value Next i End If End Sub ************************************************* ワークシート上でマウスで選択されたセルの行ごとにUserForm3のComboBox1で表示させる文字を変えたいのですが、どのようにすればよいのでしょうか。 上の(1)(2)だととマウスで選択されたセルではなく(1)(2)の範囲のセルが結合されてしまいます。。。 また、今はワークシート上でマウスを左クリックする度にUserForm3が表示されてしまいます。 これをワークシート上でマウスでセルを選択して右クリックするとUserForm3が表示される ようにしたりすることは可能なのでしょうか。
- ベストアンサー
- Visual Basic
- エクセルVBA：取得したファイル情報を別シートに貼るには・・・
いつもお世話になっています。 今エクセルVBAで指定したフォルダ内のファイル情報を取得し、sheet2に貼り付けるものを作っています。 指定したフォルダ内のファイル情報を取得するまでは分かったのですが、作ったVBAを実行するとsheet1のA2セルから自動的に貼り付けられてしまいます。 sheet2のA1セルから貼り付けるにはどうすれば良いのでしょうか？？ 作ったVBAはこんな感じです。 まず、フォルダのパスを取得しA2セルへ表示します。 Sub test2() With Application.FileDialog(msoFileDialogFolderPicker) If .Show = 0 Then Exit Sub Range("A2").Value = .SelectedItems(1) End With End Sub 次に、A2セルの値を使ってファイル名を取得しました。 Sub Test() Dim i As Long Dim pass As String pass = Range("A2").Value With Application.FileSearch .NewSearch .LookIn = pass .FileType = msoFileTypeAllFiles .SearchSubFolders = True If .Execute() > 0 Then For i = 1 To .FoundFiles.Count Cells(i + 1, 1) = .FoundFiles(i) Cells(i + 1, 3) = FileDateTime(.FoundFiles(i)) Next i End If End With End Sub です。 長くて申し訳ありません。よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- ＶＢＡでオプションボタン変更によって・・・
エクセルVBAのユーザーフォーム内にあるコンボボックス３つを選択することによりデータ入力を行っています。 この度選択肢を増やすことになり、オプションボタンを２つ追加しようと思っています。 オプションボタンはどちらかを決定することで、コンボボックスの選択内容を変更する予定です。 コンボボックスは大中小分類としており、シート２から抽出したものをシート１に落としている現状をオプションボタン新設により、ボタン１は従来通りシート２から、ボタン２選択時はシート３にあるリストからコンボボックスへ繁栄させようとしたいのですが、方法が分かりません。 どなたか、教えていただけると助かります。 よろしくお願いします。 現在のコードを下記に記します。 Private Sub UserForm_Activate() With UserForm3 .OptionButton1 = True ＊この段階でボタン２を選択時は、シート３にあるリストよりコンボボックスの内容を抽出したい。 以下中小分類も同様としたい。 .ComboBox1.RowSource = "シート２!A3:A15" .ComboBox1.SetFocus End With End Sub Private Sub ComboBox1_Change() Dim myLlist As String myLlist = ComboBox1 With UserForm3 .ComboBox2.Text = "" .ComboBox3.Text = "" Select Case myLlist Case "大１" .ComboBox2.RowSource = "シート２!B21:B26" Case "大２" .ComboBox2.RowSource = "シート２!B27:B28" End Select End With End Sub Private Sub ComboBox2_Change() Dim myMlist As String myMlist = ComboBox2 With UserForm3 .ComboBox3.Text = "" Select Case myMlist Case "中１" .ComboBox3.RowSource = "シート２!C101:C111" Case "中２" .ComboBox3.RowSource = "シート２!C121:C124" End Select End With End Sub Private Sub OKボタン_Click() With UserForm3 ActiveSheet.Unprotect 行 = ActiveCell.Row 列 = ActiveCell.Column Cells(行, 列) = UserForm3.ComboBox1.Value Cells(行, 列 + 1) = UserForm3.ComboBox2.Value Cells(行, 列 + 2) = UserForm3.ComboBox3.Value ActiveSheet.Protect End With End Sub
- 締切済み
- Visual Basic
- 最大行数を取得するVBAコードとは？
人生で初めてエクセルのマクロに挑戦してみた。が、《最大行数を取得するVBAコード》で躓いた。２時間ばかり、悪戦苦闘したがサッパリ判らない。苦肉の策で、SQL文を使った。でも、それじゃー解決したことにはならない。 Public Sub Do_XferPer() Dim I As Integer Dim N As Integer Application.ScreenUpdating = False ' ' 先頭行の取得 ' N = DLookup("SELECT COUNT(*) FROM [Sheet3$A:A1000]") - 1 Debug.Print N For I = 2 To N If 0 Then Cells(I, 1) = XferPer(Cells(I, 1)) End If Next I Application.ScreenUpdating = True With ThisWorkbook.Worksheets("Sheet3").UsedRange N = .Rows.Count - 1 Debug.Print N End With With Range("A1").SpecialCells(xlLastCell) N = .Row - 1 Debug.Print N End With End Sub 【質問】 みなさんは、最大行数を取得するのにどのようなコードを書かれていますか？ 宜しくお願いします。
- ベストアンサー
- Excel（エクセル）
- VBA のコードについて
すみません、以前にも同じようなご質問をさせて頂いたのですが、どうしても以下のマクロがうまく機能しません。 新しいブックは作成されるのですが、End If以降の検索結果が反映（コビー）されません。 コードに問題があるかアドバイス頂けますと幸いです。 どうぞ宜しくお願いいたします。 Sub sort() Dim i As Long Dim grp As String Dim newBookName As String Dim newBookPath As String Dim newBook As Workbook For i = 2 To 4 LOB = Workbooks("test").Worksheets("grpリスト").Cells(i, 2) newBookName = Workbooks("test").Worksheets("grpリスト").Cells(i, 2) & ".xlsx" newBookPath = ThisWorkbook.Path & "\" & newBookName '指定したパスにファイルが作成済でないかを確認。 If Dir(newBookPath) = "" Then '新しいファイルを作成 Set newBook = Workbooks.Add '新しいファイルをVBAを実行したファイルと同じフォルダ保存 newBook.SaveAs newBookPath Else '既に同名のファイルが存在する場合はメッセージを表示 MsgBox "既に" & newBookName & "というファイルは存在します。" End If With Workbooks("test").Worksheets("マスタ0701").AutoFilterMode = False With .Range(Cells(3, "B"), Cells(Rows.Count, "CK").End(xlUp)) .AutoFilter Field:=13, Criteria1:=grp '.CurrentRegion.Select Range(Cells(3, "B"), Cells(Rows.Count, "CK").End(xlUp)).SpecialCells(xlVisible).copy Workbooks(grp).Worksheets("Sheet1").Range("A1") '.AutoFilter End With End With Next i End Sub
- ベストアンサー
- Visual Basic
- VBAのComboBoxについて
UserForm1にComboBoxが８個(ComboBox1～8)あります。 各ComboBoxはSheet1の下記列に入力されているリストを表示します。 ComboBox1 : A列 ComboBox2 : B列 ComboBox3 : C列 ComboBox4 : D列 ComboBox5 : E列 ComboBox6 : F列 ComboBox7 : G列 ComboBox8 : H列 ComboBox9 : I列 ComboBox10 : J列 そこで、UserForm1の各ComboBoxでデータ選択する際に、リストにある場合はそれを選択し、リストにない場合はComboBoxに新しいデータを入力し、UserForm1のCommandButton1を押下時にその新しいデータをSheet1の各列に追加したいのですが、どのようにしたらよいのでしょうか。 Sheet1にあるリストをComboBoxに表示するところまではできています。 ※ComboBoxの番号とリストの列番号を一致させています。 --------------------------------------------------------------- Private Sub UserForm_Initialize() Dim lastrw As Integer, retu As Integer, i As Integer For retu = 1 To 10 lastrw = Sheet1.Cells(1, retu).End(xlDown).Row For i = 1 To lastrw - 1 Controls("ComboBox" & retu).AddItem Sheet1.Cells(i + 1, retu).Value Next i Next retu End Sub ---------------------------------------------------------------
- ベストアンサー
- Visual Basic
- Excel VBAのコンボボックス
お世話になります。 コンボボックス1と2と3は選択されますが コンボボックス4には何の表示もされません。 選択して条件設定は４つ以上できないのでしょうか？ Dim ITE As Variant Dim flg As Variant Private Sub ComboBox3_Change() 'ComboBox4セット Dim ico As Long ico = 1 With ThisWorkbook.Worksheets("data") KEY = Me.ComboBox1.Text KEY2 = Me.ComboBox2.Text KEY3 = Me.ComboBox3.Text Me.ComboBox4.Clear Do While .Cells(ico, 1) <> "" If .Cells(ico, 1) = KEY And .Cells(ico, 2) = KEY2 And .Cells(ico, 3) = KEY3 Then ITE = .Cells(ico, 4).Value flg = 0 For I = 0 To Me.ComboBox4.ListCount - 1 If ITE = Me.ComboBox4.List(I) Then flg = 1 Next If flg = 0 Then Me.ComboBox4.AddItem ITE End If ico = ico + 1 Loop End With Me.ComboBox4.SetFocus End Sub
- ベストアンサー
- その他（プログラミング・開発）
補足
回答ありがとうございます。 私の説明が解りにくい為にご迷惑をおかけしました。 Userform1とUserform2の件ですが、 Userform1は、私が記載しましたコード(Commandbutton1)のみ 設置していました。 Userform2ですが、Userform1で動作した時に Userform2が出現しUserform2内にあるCombobox1で最初にオープンした Sheet名の情報を選択し基のSheetに貼り付けする内容になっています。 Userform2のCommandbutton1ですが、下記のコードが入っています。 Private Sub CommandButton2_Click() Day = Me.ComboBox1.Value Unload Me End Su ご提示頂きましたコードを試してみました。 最初のコードでテストファイルの情報をCombobox1に表示される事が できました。 この部分を Set LstWs = LstWb.Sheets("Sheet1") 書き換えてみました。 If ComboBox1.Text = "" Then ←の部分でエラーになってしまいます。 なんででしょうか？