- ベストアンサー
エクセルVBA 他シート選択・セルへ入力
下記コード内で、シートを選択する際、マクロ呼出前は意図したとおり になるのですが、セル入力前だと上手くいきません。Activateにして もダメでした。根本的に理解していないようなので、教えてください。 よろしくお願いします。 シートAの実行ボタンをクリック Private Sub ButtonA_Click() Application.ScreenUpdating = False tempA = TextBox1 If ButtonB = True Then tempB = "10" End If Sheets("B").Select Call XYZ1 ' ----------------- （問題あり ここから）-------------- Sheets("B").Select Cells(1, 2) = 100 For i = 2 To 200 Cells(i, 2) = Range("B" & i - 1) - Range("A" & i) Next ' ----------------- （問題あり ここまで）-------------- Sheets("A").Select Call XYZ5 Application.ScreenUpdating = True End Sub
- みんなの回答 （2）
- 専門家の回答
質問者が選んだベストアンサー
その他の回答 (1)
- zap35
- ベストアンサー率44% (1383/3079)
＞マクロ呼出前は意図したとおりになるのですが、セル入力前だと上手くいきません 意味が不明です。補足をお願いしたいです。またダメが「エラーになる」という意味ならエラーコードも補足していただく方が良いと思いますよ。 またこのコードはどのモジュールシートに書いていますか。 標準モジュールシートに書いてもダメでしたか？
お礼
さっそくのご回答ありがとうございます。
補足
失礼いたしました。シートモジュールです。 エラーではなくシートBが選択されません。
関連するQ&A
- エクセル ＶＢＡ シートの選択
windows XP でエクセル２０００を使っています。 Sub aaa() Sheets("Sheet1").Select Dim a As String a = Cells(2, 4) Sheets(a).Select Range("A1").Select End Sub というマクロだと セルに入っている値のシート名を探してくれます。 ですが Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) If Intersect(Target, Range("B11:b683")) Is Nothing Then Exit Sub Worksheets("Sheet1").Range("C2").Value = Target.Value Dim b As String b = Range("C2).value （←ここをcellsにしてもダメ） Sheets(b).Select Range("A1").Select End Sub これだとsheets(b)を選びません。Sheets(b).Selectのところが黄色くなります。 何処が間違えているのでしょうか。 全くの素人ですが、仕事で必要に迫られています。 わかりやすく回答・解説くれると助かります。
- ベストアンサー
- オフィス系ソフト
- エクセルVBAでセル選択するコードが変
エクセルのワークシートでVBAでセル選択するコードで理解に苦しむことがあります。 通常、Cells(2, 1)はセル番地で言えばA2セル Cells(4, 1)はセル番地で言えばA4セルです。 しかし、 With .Range("B5:B15")でくくれば .Cells(2, 1)はセル番地で言えばB6セルだと思います。 .Cells(4, 1) はセル番地で言えばB8セルだと思います。 ところが下記のコードを動かすと、なぜかC10:C12が選択されてしまいます。 この理屈がわかりません。 Sub test02() With Sheets("Sheet1") With .Range("B5:B15") .Range(.Cells(2, 1), .Cells(4, 1)).Select End With End With End Sub なお、 .Range(.Cells(2, 1), .Cells(4, 1)).Selectを .Range(“A2:A4”).Selectに書きかえると、希望のB6:B8が選択されます。
- ベストアンサー
- Excel（エクセル）
- VBAのファインドメソッドで検索すると対象外のデータが選択されることがある
CDのリスト表（12列で、現在2269行 範囲名"収録表"）Sheets("データ")から,キーワードで該当ディスクを検索し、 結果をSheets("検索")に転記する、プログラムを作りましたが、 仮に、該当データが10件、転記されたとして そのデータを見ると、中に1件、対象外のデータがはいっている事が たまにあります、いろんな原因を考えてみましたがわかりません。 もともと、VBAのファインドメソッドが、こんなエラーを起こしやすいのか、、、（そんな事、ないよね） どなたか、教えてください。 下が、プログラムです Sub 新規検索() Application.ScreenUpdating = False Dim myData, myRng As Range Dim myWord As String myWord = InputBox("キーワードを入力してください") データ処理中F.Show vbModeless データ処理中F.Repaint Set myData = Range("収録表") Set myRng = myData.Find(What:=myWord, LookIn:=xlValues, _ Lookat:=xlPart, MatchCase:=False, MatchByte:=False) If myWord = "" Then MsgBox ("キーワードを入力してください") Exit Sub End If If Not myRng Is Nothing Then Application.Goto Cells(myRng.Row, 1), True Else: Unload データ処理中F MsgBox ("該当データはありません") Exit Sub End If Sheets("検索").Range("K1") = myRng.Row '一番最初の検索値のRow Call コピー1 Do Until Range("K1") = Range("L1") Call 次を検索 Loop Call 検索終了 Unload データ処理中F Application.ScreenUpdating = True End Sub Sub 次を検索() Dim myData, myRng As Range Sheets("データ").Select Set myData = Range("収録表") Set myRng = Cells.FindNext(after:=ActiveCell.Offset(1)) If myRng <> "" Then Application.Goto Cells(myRng.Row, 1), True End If Sheets("検索").Range("L1") = myRng.Row '2番目以降の検索値のRow Call コピー2 End Sub Sub コピー1() Sheets("検索").Range("A3:L5000,L1").ClearContents Dim myData As Range Set myData = Range("収録表") Set motorng = Application.Intersect(myData, ActiveCell.EntireRow) Set sakiRng = Sheets("検索").Range("A65535").End(xlUp).Offset(1) motorng.Copy sakiRng Sheets("検索").Visible = True Sheets("検索").Activate End Sub Sub コピー2() Dim myData As Range Set myData = Range("収録表") Set motorng = Application.Intersect(myData, ActiveCell.EntireRow) Set sakiRng = Sheets("検索").Range("A65535").End(xlUp).Offset(1) motorng.Copy sakiRng Sheets("検索").Visible = True Sheets("検索").Activate End Sub Sub 検索終了() Dim r As Long r = Range("A65536").End(xlUp).Row Range("A" & r).Select ActiveCell.FormulaR1C1 = "=COUNTA(R3C:R[-1]C)" MsgBox "全部で" & Range("A" & r).Value & "件ありました" Range("A65535").End(xlUp).EntireRow.ClearContents Call 行頭表示 End Sub
- ベストアンサー
- オフィス系ソフト
- Excelの三つのVBAを一つにまとめる。
初めまして、よろしくお願いします。当方全くの素人でVBAの基礎もよくわからず、ネットから拾ってきていじった三つのVBAがあります。この三つ、一つ一つは個別に機能するのですが、VBAとして正しいのかさえよく解っていません。この三つを一つにまとめて、同時に機能するようにしたいと頭を抱えています。 Sub TEST() Application.ScreenUpdating = False Application.EnableEvents = False ActiveSheet.Calculate Range("b10:b20").Insert shift:=xlShiftToRight Range("b10:b20").Value = Range("a10:a20").Value Application.OnTime TimeValue("09:00:00"), "TEST" Application.ScreenUpdating = True Application.EnableEvents = True ActiveWorkbook.Save End Sub ________________________________________________________________ Sub TEST1() Application.ScreenUpdating = False Application.EnableEvents = False ActiveSheet.Calculate Dim myCnt As Long Range("c30:c40").Copy Range("d30:d40").PasteSpecial Paste:=xlPasteValues Range("b30:b40").Copy Range("c30:c40").PasteSpecial Paste:=xlPasteValues Range("a30:a40").Copy Range("b30:b40").PasteSpecial Paste:=xlPasteValues nextTime = Now() + TimeValue("01:00:00") Application.OnTime nextTime, "TEST1" Application.ScreenUpdating = True Application.EnableEvents = True ActiveSheet.Calculate ActiveWorkbook.Save End Sub ________________________________________________________________ Sub TEST2() Application.ScreenUpdating = False Application.EnableEvents = False ActiveSheet.Calculate Dim myCnt As Long Range("c50:c60").Copy Range("d50:d60").PasteSpecial Paste:=xlPasteValues Range("b50:b60").Copy Range("c50:c60").PasteSpecial Paste:=xlPasteValues Range("a50:a60").Copy Range("b50:b60").PasteSpecial Paste:=xlPasteValues nextTime = Now() + TimeValue("00:10:00") Application.OnTime nextTime, "TEST2" Application.ScreenUpdating = True Application.EnableEvents = True ActiveSheet.Calculate ActiveWorkbook.Save End Sub ________________________________________________________________ 解る方、よろしくお願いします。
- 締切済み
- オフィス系ソフト
- 別なシートを開いている状態で、セル移動を移動したい
エクセルのマクロについて sheet1を開いている状態で、sheet2でセルの移動がしたいのですが。 現在下記コードを入れいています。 ----------------------------------------- Private Sub CommandButton1_Click() Application.ScreenUpdating = False Sheets("Sheet2").Select Cells(ActiveCell.Row + 1, "a").Select Sheets("Sheet1").Select Application.ScreenUpdating = True End Sub ----------------------------------------- Sheet2を開いている状態だと、思った通りセルを移動してくれますが、 Sheet1を開いている状態ですと、Sheet1上で動いているのですが。 このような事はマクロでは無理でしょうか？ どなたか、教えて頂けますか？
- ベストアンサー
- Excel（エクセル）
- エクセルVBA
よろしくお願いいたします。 エクセルのVBAですが、下記のコードを実行すると処理が遅いです。処理が早くなるコード教えてください。 よろしくお願いいたします。 Sub Macro3() Dim aa As Variant Dim i As Variant Application.ScreenUpdating = False Range("A14:i46").Select aa = ActiveSheet.Name ActiveWorkbook.Worksheets(aa).Sort.SortFields.Clear ActiveWorkbook.Worksheets(aa).Sort.SortFields.Add Key:=Range("B15:B46"), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal ActiveWorkbook.Worksheets(aa).Sort.SortFields.Add Key:=Range("C15:C46"), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With ActiveWorkbook.Worksheets(aa).Sort .SetRange Range("A14:i46") .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With For i = 0 To 31 Cells(15 + i, 7).Select If Selection.Value = 0 Then Selection.EntireRow.Hidden = True End If Next i Range("A1").Select Application.ScreenUpdating = True End Sub
- ベストアンサー
- オフィス系ソフト
- エクセルVBAで困っています。
エクセルでSheet1でSheet2に各銀行の出納帳を作りそこから各項目ごとに別Sheetに振り分けたいと思っています。 ある方にエクセルVBAで作って頂いたのですが、最初作って頂いた時の項目は会費、会議費、事務費の３つでした。その項目を９つに増やしたいと思っています。又、全てのSheetで１行目には銀行名や項目名を入れたいので２行目から日付、内容・・・といったように入力したいです。そうした場合、どこをどう変更したらよいのか分かりません。自分がわかる範囲で（適当ですが）挑んでみたのですが、私自体VBAについて全く無知のため何が何だかサッパリです。どなたか教えて頂くことはできないでしょうか。ちなみに文字数に制限があったため改行やスペースなどは入れていません。見難いとは思いますがよろしくお願いします。どうか皆様のお知恵を貸して頂けると幸いです。 Option Explicit Sub Teller() '【考え方】Sheet1とSheet2を入力と考える。 'マクロを実行したときに、Sheet1,2を元に、項目別に振り分ける。 Const BankName1 As String = "○銀行" Const BankName2 As String = "(チェック)銀行" Const tempSheet As String = "一時シート" Dim classify(9) As String Dim title(5) As String Dim i As Long Dim j As Long Dim lastRow1 As Long Dim lastRow2 As Long Dim findUpper As Long Dim findLower As Long Dim keyword As String Dim ws As Worksheet Dim Bank1 As Worksheet Dim Bank2 As Worksheet Dim Temp As Worksheet Set Bank1 = Worksheets(BankName1) Set Bank2 = Worksheets(BankName2) '【振り分ける項目名】 classify(1) = "会費" classify(2) = "会議費" classify(3) = "事務費" classify(4) = "事業費" classify(5) = "研修費" classify(6) = "報償費" classify(7) = "慶弔費" classify(8) = "予備費" classify(9) = "積立金" '【1行目に記載する見出し】 title(1) = "日付" title(2) = "内容" title(3) = "収入" title(4) = "支出" title(5) = "残高" '画面更新を停止 Application.ScreenUpdating = False '最終行取得 Bank1.Select lastRow1 = Cells(Rows.Count, 1).End(xlUp).Row Bank2.Select lastRow2 = Cells(Rows.Count, 1).End(xlUp).Row 'シートを作る For i = 1 To 3 Call MakeNewSheet_As_ThisName(classify(i)) For j = 1 To 5 Cells(1, j) = title(j) Next j Next i Call MakeNewSheet_As_ThisName(tempSheet) Cells.ClearContents Set Temp = Worksheets(tempSheet) '一時シートに、銀行1のデータと銀行2のデータをコピーする。 Bank1.Select Bank1.Range(Cells(3, 1), Cells(lastRow1, 5)).Copy Temp.Select Temp.Range(Cells(1, 1), Cells(lastRow1 - 2, 5)).PasteSpecial Bank2.Select Range(Cells(3, 1), Cells(lastRow2, 5)).Copy Temp.Select Cells(lastRow1 - 1, 1).PasteSpecial 'ソートする。 '第一優先キー：B列。[項目]昇順。 '第二優先キー：A列。[日付]昇順。 Range("A1:E" & (lastRow1 + lastRow2 - 4)).Select With ActiveWorkbook.Worksheets(tempSheet).Sort .SortFields.Clear .SortFields.Add Key:=Range("B1:B" & (lastRow1 + lastRow2 - 4)), Order:=xlAscending '第一キー .SortFields.Add Key:=Range("A1:A" & (lastRow1 + lastRow2 - 4)), Order:=xlAscending '第二キー .SetRange Range("A1:E" & (lastRow1 + lastRow2 - 4)) .Apply End With For i = 1 To 3 keyword = classify(i) findUpper = 0 findLower = 0 '上から探す For j = 1 To lastRow1 + lastRow2 - 4 Step 1 If Cells(j, 2) = keyword Then findUpper = j Exit For End If Next j If findUpper > 0 Then '下から探す For j = lastRow1 + lastRow2 - 4 To 1 Step -1 If Cells(j, 2) = keyword Then findLower = j Exit For End If Next j 'コピー Range(Cells(findUpper, 1), Cells(findLower, 5)).Copy Sheets(keyword).Select Range("A2").Select ActiveSheet.Paste Range("B2:B" & 2 + (findLower - findUpper)).Delete Shift:=xlToLeft Sheets(tempSheet).Select End If Next i '一時シートの削除 Application.DisplayAlerts = False Temp.Delete Application.DisplayAlerts = True 'アクティブセルをA1にしておく For Each ws In Worksheets Sheets(ws.Name).Select 'シート選択 Application.CutCopyMode = False Range("A1").Select Next ws Bank1.Select '画面更新を行う Application.ScreenUpdating = True MsgBox "実行しました" End Sub Sub MakeNewSheet_As_ThisName(ByVal GivenName As String) 'シートの有無を確認し、無ければ作る Dim exist_flag As Boolean Dim ws As Worksheet exist_flag = False For Each ws In Worksheets If UCase(ws.Name) = UCase(GivenName) Then 'シートが存在する場合 exist_flag = True Exit For End If Next ws 'シートを作成 If GivenName = "" Then MsgBox "空白名のシートは作れません。" ElseIf exist_flag = False Then Sheets.Add After:=Sheets(Sheets.Count) ActiveSheet.Name = GivenName End If Sheets(GivenName).Select 'シート選択 End Sub
- ベストアンサー
- オフィス系ソフト
- セルの選択について
<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 実行時エラー'1004':
どちらの処理がより高速であるのかを調べるため、以下の2つのVBAを試作致しました。 Sub Macroコピペ乱数() 'コピペ乱数 Sheets("Sheet4").Select Range("A1:A99999").Formula = "=RAND()" Columns("A").Value = Columns("A").Value Range("B1").Select End Sub 及び Sub Macro繰り返し乱数() '繰り返し乱数 Dim i As Long Randomize Sheets("Sheet4").Select For i = 1 To 99999 Range("A" & i).Value = Rnd Next i Range("B1").Select End Sub 処が、これらのVBAを実際に動作させ様としますと、どちらの場合においても「Microsoft Visual Basic」ダイアログボックスが開いて 「実行時エラー'1004': 'Range'メソッドは失敗しました:'_Global'オブジェクト」 と表示されてしまいます。 さりとて、 Sub Macroコピペ乱数() 'コピペ乱数 Sheets("Sheet4").Select ActiveSheet.Range("A1:A99999").Formula = "=RAND()" Columns("A").Value = Columns("A").Value Range("B1").Select End Sub 及び Sub Macro繰り返し乱数() '繰り返し乱数 Dim i As Long Randomize Sheets("Sheet4").Select For i = 1 To 99999 Range("A" & i).Value = Rnd Next i Range("B1").Select End Sub 或いは Sub Macro繰り返し乱数() '繰り返し乱数 Dim i As Long Randomize Sheets("Sheet4").Select For i = 1 To 99999 Range(Cells(i, 1)).Value = Rnd Next i Range("B1").Select End Sub 等としましても、今度は 「実行時エラー'1004': アプリケーション定義またはオブジェクト定義のエラーです。」 となってしまいます。 どの部分がどの様に悪いのでしょうか？ そして、どの様に修正すれば良いのでしょうか？ 尚、使用しておりますＥｘｃｅｌのバージョンはＥｘｃｅｌ2010です。
- ベストアンサー
- オフィス系ソフト
- エクセル VBA もっときれいな書き方？
Sub test() Dim i As Integer, n As Integer n = 1 For i = 2 To 150 If Cells(i, 1) <> Cells(i - 1, 1) Then Cells(i - 1, 5) = i - n Cells(i - 1, 6) = Application.WorksheetFunction.Sum(Range("B" & n & ":" & "B" & i - 1)) n = i End If Next i End Sub 上記のマクロですが Application.WorksheetFunction.Sum(Range("B" & n & ":" & "B" & i - 1)) この部分、もっとスマートに書く方法を教えてください。 Range("B" & n & ":" & "B" & i - 1)って、ちゃんと動きますが、書き方が何か変なような気がするんです。 よくわかってもいないのにすみません。
- ベストアンサー
- オフィス系ソフト
お礼
ご指摘含めてありがとうございます。上手くいきました。勉強します。