- ベストアンサー
VBAでエクセルをシート名を気にせず読み込む方法
saintandreの回答
Worksheetsコレクションはワークシート名だけではなく1から始まるインデックス番号でも指定が可能です。 Set ws = wb.Worksheets("SHEET1") <=ここが可変になります。 ↓ Set ws = wb.Worksheets(1) ※ヘルプより >単体の Worksheet オブジェクトを取得するには、Worksheets(index) プロパティを >使用します。引数 index には、ワークシートのインデックス番号または名前を指定します。 >次の使用例は、作業中のブックのワークシート 1 を非表示にします。 > >Worksheets(1).Visible = False
関連するQ&A
- エクセルVBA フォルダ内のどんなシート名であっても読み込みたい
フォルダ内の別ブック(D3で指定)の「情報」シートを読み込んで対象年月日に該当するデータを抽出して別ブックに貼り付けるものなんですが、下のコードではSet ws = wb.Worksheets("情報")と、なっていて、限定しているのですが、これをD3のファイルのどんなシート名であっても読み込みたいのですが、どのようにコードにしたらいいでしょうか?D3で指定するブックには必ずひとつのシートしかありません。 よろしくお願いします。 Sub test_1() Dim wb As Workbook Dim ws As Worksheet Dim ms As Worksheet Dim nb As Workbook Dim r As Long Set ms = ThisWorkbook.Worksheets("メニュー") Set wb = Workbooks.Open(ms.Parent.Path & "\" & ms.Range("D3").Value) Set ws = wb.Worksheets("情報") Set nb = Workbooks.Add With ws .Range("Q1").AutoFilter _ Field:=17, _ Criteria1:=">=" & ms.Range("D5").Text, _ Operator:=xlAnd, _ Criteria2:="<=" & ms.Range("F5").Text With .AutoFilter.Range r = .Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count If r = 1 Then MsgBox "抽出対象データ無し。" wb.Close False nb.Close False Set wb = Nothing: Set ws = Nothing Set ms = Nothing: Set nb = Nothing Exit Sub End If .Copy End With End With With nb.Worksheets(1) .Paste With .Range("A1:AG1") .Interior.ColorIndex = 6 .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter End With End sub
- ベストアンサー
- オフィス系ソフト
- EXCELのセルの値を表示する
VB6.0を使っています。 エクセルのC5のセルに50という値が入っています。 この値をVBのメッセージボックスで見たいのですが 実行して見てみると 「50」ではなく何故か「0」と表示されてしまいます。 どうしてでしょうか? その部分のコードは下です。 Dim Wb As Excel.Workbook Dim Ws As Excel.Worksheet Dim Ea As Excel.Application Dim atai As Integer Set Wb = GetObject("C:\test\test.xls") Set Ea = Wb.Application Set Ws = Wb.Worksheets("Sheet1") atai = Ws.Cells(3, 5) MsgBox (atai)
- ベストアンサー
- Visual Basic
- エクセルVBAで読み取りパスワード回避
エクセル2010です。 以下のコードで任意のフォルダ内のエクセルBOOKから所定のデータを取得できます。 しかし、指定フォルダ内に読み取りパスワードが設定されたものがあると、開くことができずに止まってしまいます。 読み取りパスワードが同一で、事前に分かっていればコードにPassword:="AAAABBBB" などと書き入れればいいと思うのですが、事前にはわかりませんし、パスワードもそれぞれ異なります。 そこで、開けなかった場合には、そのBOOKを飛ばしてすすみ、別シートに飛ばしたBOOK名を記録しておきたいのです。 (BOOK作成者にあとからパスワードを聞くため) しかし、残念ながらどのように書けばいいのか思いつきません。 ご指導いただければ幸いです。 Sub TEST001() Dim wb(1) As Workbook Dim ws(1) As Worksheet Dim myFdr As String, fn As String Dim i As Long With Application.FileDialog(msoFileDialogFolderPicker) 'フォルダ指定 If .Show = True Then myFdr = .SelectedItems(1) Else Exit Sub End If End With Application.ScreenUpdating = False '画面更新を一時停止 Set wb(0) = ThisWorkbook 'このコピー先ブックをwb(0)とする。 Set ws(0) = wb(0).Sheets(1) 'wb(0)の1枚目のシートをws(0)とする。 fn = Dir(myFdr & "\*.xls*") 'フォルダ内のExcelブックを検索 Do Until fn = Empty '全て検索 Application.EnableEvents = False Set wb(1) = Workbooks.Open(myFdr & "\" & fn, UpdateLinks:=False, ReadOnly:=True) 'そのブックを開きwb(1)とする。 Set ws(1) = wb(1).Worksheets(1) i = i + 1 ws(0).Cells(i, "A").Value = ws(1).Range("B2") 'ws(0)に転記 ws(0).Cells(i, "B").Value = wb(1).Name ws(0).Cells(i, "C").Value = ws(1).Name wb(1).Close (False) '保存せず閉じる Application.EnableEvents = True fn = Dir 'フォルダ内の次のExcelブックを検索 Loop '繰り返す Application.ScreenUpdating = True '画面更新停止を解除 MsgBox i & "個取得" End Sub
- ベストアンサー
- Excel(エクセル)
- AccessからExcelへの出力
質問します。 AccessからExcelへ、VBAで指定セルに指定データを落としこむコーディングをしています。 とあるサイトを参考に、下記のコードを組みましたが、実行すると砂時計のまま動かなくなってしまいます。 何が悪いのでしょうか? SQLでしょうか? 時間がなくて困っています。 何卒よろしくお願いします。(><) Option Compare Database Private Sub output() On Error Resume Next Dim app As Object Set app = CreateObject("Excel.Application") Dim oRs As Recordset Dim strSQL As String Dim Wb As Excel.Workbook Dim Ws As Excel.Worksheet Dim FileName As String Dim Worksheet As String Dim X As Long Dim Y As Long FileName = "C:\nouhinnsyo.xls" 'エクセルのファイル名 Worksheet = "納品書" 'ワークシート名 Set Wb = app.Workbooks.Open(FileName) 'ワークブックの指定 Set Ws = Wb.Worksheets(1) 'ワークシートの指定 strSQL = "SELECT 日付,伝票番号,品番,商品名,出庫数,摘要" strSQL = strSQL & vbCrLf & "FROM 棚卸マスタ" '出力用レコードセット Set oRs = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset) Y = 12 X = 0 Do Until oRs.EOF Ws.Cells(Y, X + 1) = oRs("日付") Ws.Cells(Y, X + 2) = oRs("品番") Ws.Cells(Y, X + 3) = oRs("商品名") Ws.Cells(Y, X + 4) = oRs("出庫数") Ws.Cells(Y, X + 9) = oRs("摘要") oRs.MoveNext Y = Y + 1 Loop oRs.Close Wb.SaveAs FileName 'ファイルの保存 Wb.Close 'ワークブックのクローズ Ex.Quit 'エクセルセッションをクローズする。 Set Ws = Nothing '変数の初期化 Set Wb = Nothing '変数の初期化 Set Ex = Nothing '変数の初期化 Set oRs = Nothing End Sub
- 締切済み
- その他(データベース)
- エクセルとVB6
環境は OS XP Visual Basic 6 Excel 2003 です。 エクセルを扱うについては、今回初めてです。 ソースです----------------------------------- Dim ex As Object ' Excel.Application Dim wb As Object ' Excel.Workbook Dim ws As Object ' Excel.Worksheet Set ex = CreateObject("Excel.Application") ex.Visible = True 'エクセルを表示する Set wb = ex.Workbooks.Add '空白の新しいブックを追加 Set ws = wb.Worksheets.Add '新しいシートを追加 ws.Name = "XXX " 'シートの名前を設定 'シートのセルに書き込む '構文:Cells(行, 列).Value = 値 ws.Cells(1, 1).Value = "ID" ws.Cells(1, 2).Value = "PS" III% = 2 For x% = 0 To 135 III% = III% + 1 ws.Cells(1, III%).Value = 問D$(x%, 0) Next x% ----------------------------------- エクセルが起動し、挿入されます。 質問1 シート XXXはsheet3としてに挿入され、それ以外にsheet1 sheet2もできています。 これはなぜですか。 質問2 sheet1 sheet2を生成しないようにできますか。 できないようにするには、どうすればいいですか。 全くエクセルは詳しくありません。 お詳しい方、よろしくお願いします。
- ベストアンサー
- Visual Basic
- ExcelのVBAについてです。シート1と2を作成
ExcelのVBAについてです。シート1と2を作成し、シート1にバーコードまたはキーボードで入力します。シート1は入力専用かつ入力した分の早見表で、実際にはシート2に転記仕訳して、シート3以降に表を作成したいです。使い方はシート1に入力またはシート2をタップまたはクリックすると入力(画面)になります。以前の質問の回答を参考に必要最低限に改良しています。パッと見で構いません、何か不具合は見付からないでしょうか? '///Sheet1/// Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim time7 As Range For Each time7 In Target If time7.Column = 1 Then time7.Offset(0, 4).Value = Format(Now, "Short Time") & vbCrLf & _ Format(Now, "yyyy/mm/dd hh:nn:ss AM/PM") End If Application.EnableEvents = False Application.EnableEvents = True Next time7 '(1)シートを変数にセット Dim ws1 As Worksheet Dim ws2 As Worksheet Set ws1 = Worksheets("Sheet1") Set ws2 = Worksheets("Sheet2") '(2)シートを指定してデータを転記 ws2.Range("A3:H3").Value = ws1.Range("A3:H3 ").Value End Sub Private Sub Worksheet_Activate() ' ' 新規行挿入 ' ' Worksheets("Sheet2").Range("3:3").Insert Sheets("Sheet1").Range("H3").Select ActiveCell.FormulaR1C1 = "5" Sheets("Sheet1").Range("E3").Select Selection.ClearContents Dim str_Left As String 'セルE4に文字列、セルH4に数字を予め入れておくこと。 str_Left = Left(Cells(4, 5), Cells(4, 8)) MsgBox str_Left & vbCrLf & " " & "OKボタンを押してください!" Sheets("Sheet1").Range("A3").Select Dim se_r As String se_r = Application.InputBox("バーコードを入力してください") Select Case se_r Case "False" MsgBox "キャンセルされました" Case "" MsgBox "空欄が入力されました" Case Else Range("A3").Value = se_r End Select End Sub ' ///Sheet2/// Private Sub Worksheet_Activate() Dim Emp(1 To 300) As String Dim msg As String Dim i, i2, Cnt As Integer Dim N_In As Variant For i = 3 To 3 If IsEmpty(Cells(i, 1).Value) = False Then 'ここで空欄判定 Worksheets("Sheet1").Range("3:3").Insert '対象セルアドレスを改行処理 End If '(1)シートを変数にセット Dim ws1 As Worksheet Dim ws2 As Worksheet Dim st1, s, i3 As Long Dim Bst As Range Set ws1 = Worksheets("Sheet1") Set ws2 = Worksheets("Sheet2") '(2)シートを指定してデータを転記 st1 = ws1.Cells(Rows.Count, "E").End(xlUp).Row 'A列の最終行を設定する s = 3 For i3 = 3 To st1 Set Bst = ws2.Columns("E").Find(What:=ws1.Cells(i3, "E"), LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) シート間のE列を比較 If Bst Is Nothing Then '比較して無い場合は、下記を実行 ws1.Cells(s, "A") = ws1.Cells(i3, "A") '追加する文字を転記する。(コード) s = s + 1 End If Next i3 Next i '(1)シートを変数にセット Dim ws1_ As Worksheet Set ws1_ = Worksheets("Sheet1") ws1_.Activate End Sub
- ベストアンサー
- その他(プログラミング・開発)
- VBA シート名をコピー&ペースト
いつもお世話になります。 A、Bのファイルのシートからデーターをコピーして、別ファイルsheet2にC列以降貼り付けします。 そのデーターの数だけ、そのシート名(担当者名)をB列に貼り付けしたいのですが、1行目だけしか貼り付けできません。 コードを教えていただけないでしょうか? よろしくお願いいたします。 Sub コピー() Dim ws2 As Worksheet Dim FP As Variant Dim i As Long, j As Long, t As Long, n As Long, m As Long Dim wb As Workbook '選択したフォルダのパス名を取得 FP = Application.GetOpenFilename("Excel ファイル (*.xlsm),*.xlsm", MultiSelect:=True) For i = LBound(FP) To UBound(FP) Set ws2 = ThisWorkbook.Worksheets("Sheet2") '書きだすシート Set wb = Workbooks.Open(FP(i)) 'データーファイル t = ws2.Range("D" & Rows.Count).End(xlUp).Row j = wb.Worksheets(1).Range("D" & Rows.Count).End(xlUp).Row n = ws2.Range("B" & Rows.Count).End(xlUp).Row wb.Worksheets(1).Activate wb.Worksheets(1).Range(Cells(7, 2), Cells(j, 35)).Copy ws2.Activate ws2.Range("C" & t + 1).PasteSpecial Paste:=xlValues ws2.Range(Cells(n + 1, 2), Cells(t, 2)).Value = wb.Worksheets(1).Name ←この列 Next i End Sub A、Bのファイルデーター A B C D E 1 NO 業種 物件名 目標種別 区分 2 1 あ あい かえ A 3 2 い いい きえ A 4 3 う うい くえ A 5 4 え えい けえ A 6 5 お おい こえ A コピーするファイルのシート(最終出来上がり希望) A B C D E D 1 NO 担当者 業種 物件名 目標種別 区分 2 1 鈴木 あ あい かえ A 3 2 鈴木 い いい きえ A 4 3 鈴木 う うい くえ A 5 4 鈴木 え えい けえ A 6 5 鈴木 お おい こえ A 2 1 田中 あ あい かえ A 3 2 田中 い いい きえ A 4 3 田中 う うい くえ A 5 4 田中 え えい けえ A 6 5 田中 お おい こえ A コピーするファイルのシート(現在) A B C D E D 1 NO 担当者 業種 物件名 目標種別 区分 2 1 鈴木 あ あい かえ A 3 2 田中 い いい きえ A 4 3 田中 う うい くえ A 5 4 田中 え えい けえ A 6 5 田中 お おい こえ A 2 1 田中 あ あい かえ A 3 2 い いい きえ A 4 3 う うい くえ A 5 4 え えい けえ A 6 5 お おい こえ A
- ベストアンサー
- Excel(エクセル)
- エクセル VBA シート名を別シートにコピー
早速の質問ですが エクセルVBAで シート名を別シートにコピーなのですが 10個のシートを順にシート名をコピー&ペーストしたいのです。 Dim aworkbook As Workbook Dim bworkbook As Workbook Set bworkbook = ActiveWorkbook Workbooks.Add Set aworkbook = ActiveWorkbook for i=1 to 10 bworkbook.Activate Worksheets(i).Select Application.CutCopyMode = False aworkbook.Activate Worksheets(i).Select ここに入る文章がわかりません Range("A1").Select next と以上な感じで作ってみたのですが どう貼り付けして良いかわからない状況です nextでまわす以上変数でなければだめなんでしょうけれども 構文が思いつきません。 皆様よろしくお願いいたします。
- 締切済み
- オフィス系ソフト
- VBAについて質問です。
VBAについて質問です。 現在、ExcelにてWorkbookを自動で作成するモジュールを作成しています。 モジュールを記載しているWorkbookを [wbSorce] 自動で作成されるWorkbookを [wbNew] とします。 [wbSorce] でモジュールを実行すると、 [wbNew] を新規に作成し、 データを入力して保存するのですが、保存する際に [wbNew] のイベントハンドラ [Workbook_Open] に 保存された [wbNew] を開いた時の挙動を記載するには どうすればよいでしょうか? サンプルは下記になります。 ****[wbSorce]のモジュール**** Sub wbNew_Sakusei() Dim wb As Workbook Dim wb2 As Workbook Dim i As Integer Set wb = ThisWorkbook Set wb2 = Workbooks.Add For i = 1 To 5 wb2.Sheets(1).Cells(1, i) = wb.Sheets(1).Cells(1, i) Next wb2.SaveAs Filename:="wbNew" End Sub ****[wbNew]に記述したいモジュール**** Private Sub Workbook_Open() ActiveWindow.ScrollRow = 1 MsgBox "Workbook_Openイベントが発生しました。" End Sub
- ベストアンサー
- その他MS Office製品
- VBAが止まります。
フォルダ内の全てのエクセルデータを一つにまとめたいのですが、 下記を実行すると、添付ファイルのメッセージが出て先に進みません。 調べましたがよくわかりませんので、ご教示いただけませんでしょうか。 画像の最上部の『'プログラム0|変数設定の指定Option Explicit』が欄外に はみだしていて直せません、こちらが原因でしょうか。 ------------------------------------------------------- 'プログラム1|プログラム開始 Sub GetExcelDataInFolder() 'プログラム2|シート設定 Dim ws1 As Worksheet Set ws1 = ThisWorkbook.Worksheets("Sheet1") 'プログラム3|FileSystemObjectの設定 Dim fs As FileSystemObject Set fs = New FileSystemObject 'プログラム4|対象フォルダを取得 Dim myfolder As Folder Set myfolder = fs.GetFolder(ThisWorkbook.Path) 'プログラム5|対象フォルダ内の全ファイルを処理 Dim myfile As File For Each myfile In myfolder.Files 'プログラム6|拡張子が「xlsx」のファイルのみを処理 If fs.GetExtensionName(myfile) = "xlsx" Then 'プログラム7|フォルダ内のエクセルを開いてシートを設定 Dim wb As Workbook Set wb = Workbooks.Open(Filename:=myfile) Dim ws2 As Worksheet Set ws2 = wb.Worksheets(1) 'プログラム8|開いたエクセルの最終行を取得 Dim cmax As Long cmax = ws2.Range("A65536").End(xlUp).Row Debug.Print myfile.Name & "のcmax=" & cmax 'プログラム9|開いたエクセルのデータを転記 Dim i As Long For i = 2 To cmax Dim cmax1 As Long cmax1 = ws1.Range("A65536").End(xlUp).Row ws1.Range("A" & cmax1 + 1 & ":E" & cmax1 + 1).Value = ws2.Range("A" & i & ":E" & i).Value Next 'プログラム10|エクセルを閉じる wb.Close 'プログラム11|オブジェクト解放 Set ws2 = Nothing Set wb = Nothing End If Next 'プログラム12|エクセルを保存 ThisWorkbook.Save 'プログラム13|オブジェクト解放 Set myfolder = Nothing Set fs = Nothing 'プログラム14|プログラム終了
- 締切済み
- Visual Basic
お礼
インデックス番号でも指定が可能 ありがとうございます。 助かりました。