- ベストアンサー
このマクロの意味をおしえてください。
マクロ初心者ゆえ簡単なマクロを組んでエクセルファイルを作っていましたが ある時気がつくと以下のようなマクロが書き込まれていました。 Private Sub Worksheet_Activate() Set Rng = ActiveWindow.VisibleRange X = Rng(Rng.Count).Row ScrollArea = "A1:IV" & X End Sub このマクロはどういう意味でしょうか？ 自分で書き込んだ記憶が無く、かといって勝手に書き込まれるはずも無く。。。 削除してしまって良いのか悩んでいます。 よろしくご教授ください。
- SORAN27
- お礼率66% (66/99)
- オフィス系ソフト
- 回答数1
- ありがとう数3
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
当該のシートを開いた際に，現在の表示範囲の外にスクロールできないようにしたいマクロと推測できます。 言わずもがなですがこういったマクロが「自動生成」されるはずもなく，どこかから拾ってきたブックにそういう具合に仕込まれていたか，若しくはご自分で設定したのを忘れているだけでしょう。 必要ないと判断したなら，削除するだけです。 Private Sub Worksheet_Activate() ’当該のシートを開いた際に自動実行する Set Rng = ActiveWindow.VisibleRange ’現在の表示状態において表示されているセル範囲を変数Rngに取得する X = Rng(Rng.Count).Row ’変数Rngに格納されたセル範囲の最後のセルの行番号を変数xに取得する ScrollArea = "A1:IV" & X ’現在のウィンドウでスクロール可能な範囲として，A1セルからIV列のX行までのセル範囲を設定する End Sub
関連するQ&A
- エクセル スクロール制限の解除方法
Sub Worksheet_Activate() Set Rng = ActiveWindow.VisibleRange X = Rng(Rng.Count).Row ScrollArea = "A1:IV" & X End Sub 以上のようなマクロを実行したのはよいのですが、 解除する方法がわからず困っております。 どなたか、お助け下さいますでしょうか。 よろしくお願い致します。
- 締切済み
- オフィス系ソフト
- エクセル画面を上下に２分割した場合のマクロについて
エクセル画面を上下に２分割したく、下記のマクロを用いております。 すなわち、上下２分割した上のほうのシートは、A1:S30 までスクロール可能とし、 下のほうのシートは、A50:S80までスクロール可能です。 しかし、操作中に、上のシート表示が、いけないはずの５０列あたりまでスクロールしてしまい、戻せなくなってしまいます。また、下のシートも同様です。 難しいかと思いますが、上下のシートが表示列を守るようにできますでしょうか。 Private Sub Worksheet_SelectionChange(ByVal Target As Range) On Error Resume Next If ActiveWindow.Panes.Count = 1 Then ActiveSheet.ScrollArea = "" Exit Sub End If ActiveSheet.ScrollArea = IIf(ActiveWindow.ActivePane.Index = 1, "A1:S30 ", "A50:S80") End Sub
- ベストアンサー
- オフィス系ソフト
- 再び質問です。１つのシートを上下に分割した状態で、
できれば、新しいウィンドウを開かずに、 ウィンドウ⇒分割 １つのシートを上下に分割した状態で、 上半分のシートは、縦のスクロールが１から５０までに制限し、 下半分のシートは、縦のスクロールが６０から１００までに制限したいのです。 ↑ここまでは、解決しました。（下記マクロ） Private Sub Worksheet_SelectionChange(ByVal Target As Range) If ActiveWindow.Panes.Count = 1 Then ActiveSheet.ScrollArea = "" Exit Sub End If ActiveSheet.ScrollArea = IIf(ActiveWindow.ActivePane.Index = 1, "1:50", "60:100") End Sub できれば、同時に水平のスクロールをＡ列からＰ列までに制限したいのですが、 マクロの続きを教えていただけると幸いです。
- 締切済み
- オフィス系ソフト
- マクロを使って・・・
シート1に入力したデータをシート2にコピーするいうマクロを作りました。 シート2にコピーはできるのですが 例えば、そのデータを消して再度新しいデータを入れていきたいと思い エクセル左上のシート全体を選択して「Delete」を押すと 会社のエクセル（2003？）は中断モードがどーのこーのとエラー画面が出て マクロが黄色になって、前に進めません。 やり方が決まっているのでしょうか? コピーした行全体を選択して右クリック「削除」とすると エラー画面が出ません。 やり方など決まっているのでしょうか? ↓がんばって作ったマクロです Sub 正方形長方形4_Click() Call macro01 Call macro02 End Sub Sub macro01() Dim ws1 As Worksheet, ws2 As Worksheet Dim x As Long, y As Long Set ws1 = Sheets("Sheet1") Set ws2 = Sheets("Sheet2") x = ws2.Cells(Rows.Count, "b").End(xlUp).Row + 1 y = ws1.Cells(Rows.Count, "b").End(xlUp).Row ws1.Cells(21, "b").Resize(y, 9).Copy ws2.Cells(x, "B").PasteSpecial Paste:=xlPasteValues ←この行が黄色になります Application.CutCopyMode = False End Sub Sub macro02() Worksheets("Sheet1").PrintOut End Sub
- ベストアンサー
- オフィス系ソフト
- マクロで条件付き書式（セルの塗りつぶし）
2003のため、条件付書式を5つ作るのにマクロが必要なのですが触ったことないので全くわかりません。以下のマクロ作ったのですが、"コンパイルエラー End Subが必要です"と出てしまいます。どこが悪いのか見当も付きません（TT）。添削をお願いします。 やりたいことは、「決まっている範囲内に入力されている単語別にセルの色を分ける」です。 Sub 条件() Private Sub Worksheet_Change(ByVal Target As Range) Dim rng As Range Set rng = IntersectC9: F28 If rng Is Nothing Then Exit Sub Dim x As Range For Each x In rng Dim myColor As Integer Select Case x.Value Case "りんご": myColor = 3 '赤色 Case "ばなな": myColor = 45 'オレンジ色 Case "みかん": myColor = 6 '黄色 Case "いちご": myColor = 5 '青色 Case "他": myColor = 4 '緑色 Case Else: myColor = xlNone End Select x.Interior.ColorIndex = myColor Next x Set rng = Nothing Set x = Nothing End Sub
- ベストアンサー
- オフィス系ソフト
- このマクロの意味を教えてください。
このマクロの意味を教えてください。 このマクロの意味を教えてくれませんか？変な質問で申し訳ありません。というのも、先日インターネットからひろってそのままま真似して使っていたのですが、不具合が起こってしまいました。 しかし、どこからひろったのかどう検索しても見つからず、自分で不具合の原因がわからないのです。 どなたか、教えていただけないでしょうか。 このひとつひとつのマクロの意味を教えていただけたら大変助かります。 Sub test01() Dim sh1 As Worksheet Dim sh2 As Worksheet Set sh1 = Worksheets("元データ") Set sh2 = Worksheets("RMA") '-- d = sh1.Range("a65536").End(xlUp).Row For i = 2 To d If sh1.Cells(i - 1, "E") <> "" Then sh2.Cells(1, "A") = i - 1 sh2.Range("A2:I51").PrintOut End If Next i End Sub
- ベストアンサー
- Visual Basic
- エクセル デバッグできるのとできないのがある
シートイベントについて教えてください。 シートモジュールに --------------------------------------------------------- Option Explicit Private Sub Worksheet_Activate() MsgBox "" End Sub Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) MsgBox "" End Sub Private Sub Worksheet_Change(ByVal Target As Range) MsgBox "" End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) MsgBox "" End Sub --------------------------------------------------------- と記載した時に、 Ｆ８で動かせるのは、Worksheet_Activateだけなのですがなぜでしょうか？ ほかのイベントは、F8で実行させても、ＯＳの音が鳴るだけで、マクロの実行はされません。 ご回答よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- セルを結合するマクロ
マクロ初心者です。 Aセルをブランク領域で選択してマクロを実行しますとセルが結合します。 最後の空白がどこまでかは、何か指定がないといけないので、仮にエンドと名付けます。 このコードはA列のみです。A列からM列またはL列までと指定するにはどうすれば良いですか？ ご教鞭をお願いします。 Sub test() Set Rng = Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp)) Set blanks = Rng.SpecialCells(xlCellTypeBlanks) For Each ar In blanks.Areas Union(ar(1).Offset(-1), ar).Merge Next Cells(Rows.Count, 1).End(xlUp).ClearContents End Sub
- ベストアンサー
- Excel（エクセル）
- Excel VBA 配列による複数セルへの入力
VBA初心者です．よろしくお願いいたします． 用語の読みを自動で振るシートを作成しているのですが，Do Loop部分が一行ずつの入力となっていて，時間がかかっています． これを配列等の方法を用いて高速化したいと思って，試行錯誤したのですが，うまくいきません． 何卒お教えくださいますようお願いいたします． 用語の読みを生成する手順ですが， １．シート1に用語をペーストする ２．ペーストされた用語をシート２にある用語のDB（用語と読みが入力されています．重複レコードなし）にコピー ３．コピーされたシート２をピボットにして個数が２以上あった場合，その用語と読みを返します． ４．Do Loopで最初にヒットした用語に戻るまでループ となっています． ３までの手順に修正の必要はないのですが，４の手順でかなり時間をロスしております． ここを配列等の方法で一度に書き込むことができればと思っています． Sub test() i = 8 L_Row04 = 180188 Dim S1 As Worksheet '読みを振る用語をペーストするシート Dim S2 As Worksheet '読み用の用語のDB Dim S3 As Worksheet 'ピボット Dim L_Row01 As Long 'S1にペーストされた用語の最下行 Dim L_Row02 As Long 'S1の用語をs2にペーストしたときの最下行 Dim L_Row03 As Long 'ピボットの用語の最下行 Dim Rng01 As Range 'S1にペーストされた用語の範囲 Dim Rng02 As Range 'S2にペーストされた用語の範囲 Dim Rng03 As Range 'ピボットの範囲 Dim Str01 As Variant 'ピボットで2以上あったときの用語 Dim Str02 As Variant 'ピボットで2以上あったときの読み Dim firstcell As Range Dim Foundcell01 As Range Set S1 = Worksheets(1) Set S2 = Worksheets(2) Set S3 = Worksheets(3) S1.Activate L_Row01 = S1.Cells(Rows.Count, 2).End(xlUp).Row L_Row02 = S2.Cells(Rows.Count, 3).End(xlUp).Row Set Rng01 = S1.Range(Cells(i, 2), Cells(L_Row01, 2)) Rng01.Copy Destination:=S2.Cells(L_Row02 + 1, 2 + 1) S3.PivotTables("ピボットテーブル2").RefreshTable S2.Activate L_Row02 = S2.Cells(Rows.Count, 3).End(xlUp).Row Set Rng02 = S2.Range(Cells(L_Row04, 3), Cells(L_Row02, 3)) Rng02.Delete S3.Activate L_Row03 = S3.Cells(Rows.Count, 2).End(xlUp).Row Set Rng03 = S3.Range(Cells(4, 2), Cells(L_Row03, 2)) For Each a In Rng03 If a >= 2 And a.Offset(0, -1).Value <> "(空白)" And a.Offset(1, -1).Value <> "(空白)" Then Str01 = a.Offset(0, -1) Str02 = a.Offset(1, -1) S1.Activate Set Foundcell01 = Rng01.Find(What:=Str01, searchorder:=xlByRows, LookIn:=xlValues, lookat:=xlWhole) Do Selection.Offset(0, 1).Value = Str02 Selection.Offset(0, 2).Value = "●" Loop Until ActiveCell.Address = firstcell.Address End If End If Next End Sub
- ベストアンサー
- Visual Basic
お礼
ありがとうございます。 内容が分かってスッキリしました。