プロが教えるわが家の防犯対策術!

初歩的な質問で申し訳ありません。
VBAの最終行取得についてご教授宜しくお願い致します。
ワークシートのA1には”製品コード”
の文字が入った状態です。
別のブックからデータを取得し、A2に表示させます。
A2のValueを変数cord1に
A2の上4桁を変数cord2に入れるというものなのですが、、、
Rc=cells(Rows.count,1).End(xlup).Row
cells(Rc +1,”A”).Value=8001001
Set cord1=cells(Rc,”A”)
cord2=Left(cells(Rc,”A”),4)
としました。
cord1は8001001
cord2は8001
となって欲しいのですが結果は
cord1は”製品コード”
cord2は”製品コー”
となってしまいました、、、
cells(Rc +1,”A”).Value=8001001
とした時点で、最終行はA1の”製品コード”
からA2の8001001に移っていると思ったのですが、最終行として認識してくれません。
何が問題なのでしょうか、、、
乱文失礼致しました。
どうか、よろしくお願い致します。

A 回答 (1件)

こんにちは



コードは記述内の制御に従いながら、上から順に実行されてゆきます。

>Rc=cells(Rows.count,1).End(xlup).Row
が実行された時点で、最終行(例えば200としておきます。)が変数Rcに代入されます。
この時の200はただの数値で、「最終行を示す」とか「セルの位置を表す」といった意味はありません。
これに勝手に意味を付けているのはコードの作成者であって、変数にとってみれば単なる200という数値でしかありません。
「100+100」や「1000/5」の計算結果と、なんら変わるものではないということです。

ですので、
>cells(Rc +1,”A”).Value=8001001
を実行したからといって、変数Rcの内容が変わることはありません。
(変数Rcの内容を変更もしていないのに変わってしまうようでは、困る人が続出することと思います)

Rc+1行目に値をセットした後で、再度
 Rc=cells(Rows.count,1).End(xlup).Row
を実行してみると、今度は、変数Rcには 201 の数値が代入されるはずです。


もしも、機能的に常に最終行を参照できるようなものが欲しいような時は、
 Function lastRow()
  lastRow = Cells(Rows.Count, 1).End(xlUp).Row
 End Function
のような関数を別に定義しておいて、変数を使う代わりに
 Cells(lastRow(),1).Value
といった参照方法をとることで、シートの記入状況に拘わらず、常に(その時点での)最終行の値を参照するコードになります。
    • good
    • 0
この回答へのお礼

素早い回答誠にありがとうございます!
Rows.countが常に最終行を取得するものだと勝手に理解してしまっていました…
常に最終行を取得することは全く別にあったんですね!
本当にありがとうございす!
たいへん勉強になりました。
今度もこのような初歩的な質問をするかと思いますが、今度とも宜しくお願い致します。

お礼日時:2019/02/14 12:26

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aと関連する良く見られている質問

Q自分のパソコンではVBAが起動しますが‥ 他のパソコンでやってみると起動せずに インデックスが有効範

自分のパソコンではVBAが起動しますが‥
他のパソコンでやってみると起動せずに
インデックスが有効範囲にありませんの
エラーが出てしまいます。

何故でしょう?

だいたい下記のようなVBAになります。

Sub SendingSheet()
 Dim wb As Variant
 Dim WkBk As Variant
 For Each wb In Workbooks
  If (wb.Name) Like "FTN*【チェックシート】*.xls?" And wb.Name <> ActiveWorkbook.Name Then
   Set WkBk = wb
   Exit For
  End If
 Next
 If IsObject(WkBk) Then
  On Error Resume Next
  With WkBk
   ActiveSheet.Copy After:=WkBk.Worksheets(.Worksheets.Count)
ActiveSheet.name= "シートA"
   Beep  'コピーしたら音がなる
  End With
  If Err.Number <> 0 Then
   MsgBox Err.Number & " :" & Err.Description
  End If
  On Error GoTo 0
 Else
  MsgBox "該当するブックは開いていません。", vbExclamation
 End If
End Sub

----------------
よろしくお願いします。

自分のパソコンではVBAが起動しますが‥
他のパソコンでやってみると起動せずに
インデックスが有効範囲にありませんの
エラーが出てしまいます。

何故でしょう?

だいたい下記のようなVBAになります。

Sub SendingSheet()
 Dim wb As Variant
 Dim WkBk As Variant
 For Each wb In Workbooks
  If (wb.Name) Like "FTN*【チェックシート】*.xls?" And wb.Name <> ActiveWorkbook.Name Then
   Set WkBk = wb
   Exit For
  End If
 Next
 If IsObject(WkBk) Then
  On Error Resume Next
 ...続きを読む

Aベストアンサー

ちょっと割り込みさせていただきます。
ほとんど、前の方のやり取りは読まずに、コードを直してみました。

"FTN*【チェックシート】*.xls? というブックがあったら、そこにシートのコピーを送るというマクロですよね。
見た目は簡単なマクロのようですが、ひじょうにややこしくしているのは、マクロを搭載しているThisWorkbookの存在です。そのBookと、"FTN*【チェックシート】*.xls?は、同一ではない、というコードになっているからです。その条件は含め、ご質問者さんのコードは活かしました。

>"FTN*【チェックシート】*.xls?"
>上記のBookにコピーしてほしいのに
>アクティブBookへ名前を付けてコピーされて
>しまいます。

やはりそうなのですね。こちらのマクロでも、なぜかコピー後に、Active化が移動していないということです。(Excel 2016) //明示的にActiveの親オブジェクト(Book)から指定しなくてはならないようです。

ファイル(ブック)を特定化するロジックが大雑把ですね。一旦、見つけたブックを、さらに、Activeかどうかを調べるのであって、同時に両方の条件を調べたら、ブックがないことになってしまいます。

なお、こちらでは、エラーを避けるために、「 "シートA-" & .Worksheets.Count 'オプショナル」というオプションを設けました。それと、エラー・ストップというのは、通常は、ステップマクロで分かるものです。


'//標準モジュール(アドインを含む)
Sub SendingMySheet()
 Dim Wb As Variant
 Dim WkBk As Workbook
 Dim acWb As Workbook
 Dim sh As Worksheet

 On Error GoTo ErrHandler

 For Each Wb In Workbooks
  If Wb.Name Like "FTN*【チェックシート】*.xls?" Then
   If Wb.Name <> ActiveWorkbook.Name Then
    Set WkBk = Wb
    Exit For
   Else
    MsgBox Wb.Name & "はアクティブではできません。", vbExclamation
    Exit Sub
   End If
  End If
 Next Wb
 If Not WkBk Is Nothing Then
  Set acWb = ActiveWorkbook
  With WkBk
   acWb.ActiveSheet.Copy After:=.Worksheets(.Worksheets.Count)
   .ActiveSheet.Name = "シートA-" & .Worksheets.Count 'オプショナル
   Beep
  End With
 Else
  MsgBox "該当するブックは開いていません。", vbExclamation
 End If
ErrHandler:
 If Err() <> 0 Then
  MsgBox Err.Number & " :" & Err.Description
 End If
End Sub

ちょっと割り込みさせていただきます。
ほとんど、前の方のやり取りは読まずに、コードを直してみました。

"FTN*【チェックシート】*.xls? というブックがあったら、そこにシートのコピーを送るというマクロですよね。
見た目は簡単なマクロのようですが、ひじょうにややこしくしているのは、マクロを搭載しているThisWorkbookの存在です。そのBookと、"FTN*【チェックシート】*.xls?は、同一ではない、というコードになっているからです。その条件は含め、ご質問者さんのコードは活かしました。

>"FTN*【チェッ...続きを読む

Qマクロのコピーペーストが上手く行きません

電気試験の規格条件を、EXCELデータとし、信頼性試験のグラフブックの規格表に貼り付け、EXCELでグラフ作成をします。コンセプトは、フォーム上で規格表データを読み込み、グラフ表も読み込み貼り付けるで、フォームのコードは、完全の様で、データは入っています。
モジュールのロジックは良いと思うのですが、モジュール部をF8で動かせる解析すると、変数Iは、1までしか動かず、D,Data(dfile)は、データが入りません。モジュール部で問題ないでしょか。
1)kは動くが、iが、Len関数が効いていないのか、1以外変化しない。iに対するLenの使い方はこれで良いのでしょうか?
(Cells find以下が動いていなくて、Copyができないようなので)
2)dfilename(1)が入っていないがDataに読み込ませる方法は無いでしょうか?TEXTNOも変数宣言してみました。
3)D=Val(mid)関数だが、これで動くのでしょうか?
規格転送は、オブジェクト名です。
Sub dialog_show()
規格転送.規格ファイル = ""
規格転送.送られ側 = ""
規格転送.Show
If Button = "ok" Then Call main
End Sub

Sub main()
Dim sinn
Dim i
Dim k
Dim Data
Dim D
Workbooks.Open Filename:=gfilename(1)
sinn = ActiveWorkbook.Name
Sheets("規格値").Select
Range("E10").Select
ActiveCell.Offset(0, 0).Range(Cells(1, 1), Cells(15, 7)).Select
Selection.ClearContents

For k = 1 To 7
For i = 1 To i = Len(TESTNO) / 2 'Test項目数

Workbooks.Open Filename:=dfilename(1)
Data = ActiveWorkbook.Name
Windows(sinn).Activate
Range("E10").Select
ActiveCell.Offset(k - 1, i - 1).Select
Windows(Data).Activate
D = Val(Mid(TESTNO, (i - 1) * 2 + 1, 2)) 'Test項目の番号
Cells.Find(What:="D", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) _
.Activate
ActiveCell.Offset(k - 1, 0).Copy
Windows(sinn).Activate
Selection.PasteSpecial Paste:=xlFormula
Next i

Next k

ActiveWindow.Close
If k = 7 Then
Application.ScreenUpdating = True
MsgBox ("終了しました")
End If

End Sub

電気試験の規格条件を、EXCELデータとし、信頼性試験のグラフブックの規格表に貼り付け、EXCELでグラフ作成をします。コンセプトは、フォーム上で規格表データを読み込み、グラフ表も読み込み貼り付けるで、フォームのコードは、完全の様で、データは入っています。
モジュールのロジックは良いと思うのですが、モジュール部をF8で動かせる解析すると、変数Iは、1までしか動かず、D,Data(dfile)は、データが入りません。モジュール部で問題ないでしょか。
1)kは動くが、iが、Len関数が効いていないのか、1以...続きを読む

Aベストアンサー

No.1です。
F8(ステップイン)を使っているのであれば、ウォッチ(式)もご存知ですよね?
先ずは
1.「TESTNO」の内容を確認
>TESTNOの中に、試験項目が、’07131521092632’の様な続いた2桁の番号で入ります。
とありますが、本当に想定通りの値が入っているのか?
手違いで値が入っていない状態で走っていいる可能性もあります。

2.「Len(TESTNO)」の確認
3.「D」の確認
を行うしかないでしょうね。
どちらにしても
>Cells.Find(What:="D", ・・・
ではなく、
Cells.Find(What:=D,・・・
※検索対象は文字「D」 ではなく、「Dの値」ではないでしょうか?
また、検索対象のシートが決まっているのであれば
Sheets("規格値").Find(What:=D,・・・
のようにした方が良いでしょう。
※列番号などが決まっているのであれば、Sheets("規格値").Rews(〇〇).Find・・・の方がベター。
SelectとActivateが多く、SelectionやActiveCellが何処なのかが分りずらい印象です。

No.1です。
F8(ステップイン)を使っているのであれば、ウォッチ(式)もご存知ですよね?
先ずは
1.「TESTNO」の内容を確認
>TESTNOの中に、試験項目が、’07131521092632’の様な続いた2桁の番号で入ります。
とありますが、本当に想定通りの値が入っているのか?
手違いで値が入っていない状態で走っていいる可能性もあります。

2.「Len(TESTNO)」の確認
3.「D」の確認
を行うしかないでしょうね。
どちらにしても
>Cells.Find(What:="D", ・・・
ではなく、
Cells.Find(What:=D,・・・
...続きを読む

Q20万を 超える、連番の 生成。

お世話になります。


「,」や、「;」で、
区切られた、
定数配列や、配列数式上の、
等差連番数値を 20万個以上、

VBAを 使わず、
生成したいのですが、

何か 良い方法は、
ありますでしょうか?


宜しく お願いします。

Aベストアンサー

こんにちは

シートやセルは利用しても良いものと解釈しました。
ひとまず、20万行を超えられる、行数の方を利用する方法で考えてみました。

まず、必要となる等差数列をROW()に基づいた式として表します。
(例えば、 =ROW()*2-1 1,3,5…の等差数列)
この式をコピーしておいて、シートのA列全体を選択した状態で、ペーストします。
この結果、A1、A2…に1、3、5…と最終行まで表示されます。

単純な式でできないような内容でも、A列を利用してさらに関数式で値を作成することも可能でしょう。
例えば、B1セルに =A1*2 として、セルの右下をダブルクリックすれば最終行まで式がコピーされます。


配列数式等で利用する場合には、A:Aあるいは必要な範囲を切り取って参照することで、そのまま多行1列の配列として利用できると思います。
1行多列の場合も同じ方法で作成可能ではありますが、エクセルのシートは2万列もないため、残念ながら20万には程遠い数にしかなりません。

試してはいませんが、前記の多行1列の配列をTRANSPOSEで行・列の反転をさせることで、1行多列のお求めの内容にも変換することができるものと考えます。


※ そもそも20万超の要素の配列数式を、エクセルがどのくらいで計算できるのかに不安を感じますが・・・

こんにちは

シートやセルは利用しても良いものと解釈しました。
ひとまず、20万行を超えられる、行数の方を利用する方法で考えてみました。

まず、必要となる等差数列をROW()に基づいた式として表します。
(例えば、 =ROW()*2-1 1,3,5…の等差数列)
この式をコピーしておいて、シートのA列全体を選択した状態で、ペーストします。
この結果、A1、A2…に1、3、5…と最終行まで表示されます。

単純な式でできないような内容でも、A列を利用してさらに関数式で値を作成することも可能でしょう。
例えば、B1セル...続きを読む

Qユーザーフォームが消えない

今、ユーザーフォームを勉強しています。
手始めに、ラベルを表示して、2秒経ったら消す。
ということをやろうとして下記の通り書きましたが、
消えてくれません。
何処が間違っているのでしょうか。
宜しくお願いします。

Sub test2()
Load UserForm1
UserForm1.Label1.Caption = "ABC"
UserForm1.Show
Sleep 2000
UserForm1.Hide
Unload UserForm1
End Sub

Aベストアンサー

難しい質問ですね。
ご自身で参考にしたコードがあるのでしょうか。
ModalMode に関しては、なんとも言えないのは、UserForm 上で、Lable に命令を出しているからです。
それがなければ、後は補填するだけで済みます。
なお、Sleep を使っていらっしゃるようですが、Sleep 自体は、Win API ですから、もちろん、エラーが出ているはずです。

Load UserForm1
UserForm1.Label1.Caption = "ABC"
UserForm1.Show
Sleep 2000 --ここまでで、UserForm のメモリが安定しないので、Label の操作ができないのではないでしょうか。

ふつう、自己消去型のメッセージは、Win API を利用するのですが、UserForm を活かすなら、

Sub test2()
 Application.OnTime Now + TimeSerial(0, 0, 2), "UserFormColse"
 With UserForm1
  .Label1.Caption = "ABC" 'マクロが一定の終了をしないと出てこない
  .Show 'vbModeless 'この場合は、どちらでもよい。
 End With
End Sub

Sub UserFormColse()
 Unload UserForm1
End Sub

Label.Caption ="ABC" がなければ、問題はSleep の部分と余分な部分を切り落とすだけです。
こんなふうにしか私は思いつかなかったです。

その代用品として、このようなコードがあります。
Private Declare Function MessageBoxTimeoutA Lib "user32" (ByVal hWnd As Long, ByVal _
lpText As String, ByVal lpCaption As String, ByVal uType As Long, ByVal _
wLanguageId As Long, ByVal dwMilliseconds As Long) As Long

Sub TimeOutMessage()
MessageBoxTimeoutA 0&, "ABC", "メッセージ", vbMsgBoxSetForeground, 0, 2000 '2秒
End Sub

参考まで。

難しい質問ですね。
ご自身で参考にしたコードがあるのでしょうか。
ModalMode に関しては、なんとも言えないのは、UserForm 上で、Lable に命令を出しているからです。
それがなければ、後は補填するだけで済みます。
なお、Sleep を使っていらっしゃるようですが、Sleep 自体は、Win API ですから、もちろん、エラーが出ているはずです。

Load UserForm1
UserForm1.Label1.Caption = "ABC"
UserForm1.Show
Sleep 2000 --ここまでで、UserForm のメモリが安定しないので、Label の操作ができないのではないでし...続きを読む

QExcelで「令和」と表示されるのは5月1日にならないとだめですか?

「日本の新元号に関する Office の更新プログラム」というページ(下記)で、
「Windows と Office の更新プログラムを適用済みの場合でも、Windows 上で実行されている Office 製品は 2019 年 5 月 1 日に新元号が開始されるまで、新元号を表示しませんのでご注意ください。」
と書かれています。
https://support.microsoft.com/ja-jp/help/4478844/office-updates-for-new-japanese-era

今月4月中に、Excelのセルに来月5月以降の年月日を入力した場合に、自動で「令和」という元号を表示させることはできないのでしょうか。

もし、できるということであれば、「2019 年 5 月 1 日に新元号が開始されるまで、新元号を表示しません」とはどのような意味なのでしょうか。

Aベストアンサー

>こちらでは、「4月17日以降にOfficeも更新されれば「令和元年」と表示されると思います」と書かれているんですが

その方は、Microsoftの方ではないですし個人の予想ですよね?公式が出ているのにそれを持ち出してどうするんですか?

5/1より前に新しい元号を表示したい場合は数式や表示形式で限定的に表示させる方法を色々な方が考え付いていますよ。
検索すればたくさん出てきます。

QExcel 画像反映 VBA について

Excel で、カタログ管理をしています。
カタログは『品番、品名、サイズ、その商品の画像』が元になります。
順次カタログの内容は増えていきます。

これまでは、画像付きでの管理ではなか
ったので、"DATA BASE"という名のsheetを作成し、別タブに"表示用"のsheetも作成。
その都度必要品番を"表示用"のA列に入力するし、vlookup関数を使い、B.C.D列に必要情報が"DATABASE"から自動的に取れる状態、なおかつその都度欲しいデータを自分の欲しい順番で表示させて表示用sheetのみを提出することで発注がかけられました。

ですが、"画像"を付けなければならなくなり、格闘しています。

いま自分が分かっていることは、
vlookupやIndex,Match関数だけでは手に負えないということです。またそれなりのDATA BASEの量になってしまい、増してこれからどんどん増える予定なので汎用性を持たせたいのです。

ここでVBAマクロにてどうにか、画像付きで"表示用"のsheetに反映させることは出来ないかと考えております。

現在"DATA BASE"は画像付きで作成してあります。できることならば、B列に表示されている、品名と同じcellに画像を反映させたいと思っています。

まだまだ初心者ですが、VBAマクロを組み作成したことはあります。
ですが、画像の反映や、vlookupで出来ることはわざわざマクロを組まずにやってきてしまったので、
Excelでの画像付きデータの管理について、
+私なんかよりもVBAにもっと詳しい方、
お知恵をお貸しください。。。

よろしくお願いします。(><)

Excel で、カタログ管理をしています。
カタログは『品番、品名、サイズ、その商品の画像』が元になります。
順次カタログの内容は増えていきます。

これまでは、画像付きでの管理ではなか
ったので、"DATA BASE"という名のsheetを作成し、別タブに"表示用"のsheetも作成。
その都度必要品番を"表示用"のA列に入力するし、vlookup関数を使い、B.C.D列に必要情報が"DATABASE"から自動的に取れる状態、なおかつその都度欲しいデータを自分の欲しい順番で表示させて表示用sheetのみを提出することで発注がかけ...続きを読む

Aベストアンサー

こんにちは

VBAで処理なさるのなら、それはそれでも良いですが、頑張ればVBAを用いなくても、画像を可変にすることは可能です。
(どこかにデータベース的にまとめて置いておく必要はあります)

https://qiita.com/Cremokoroah/items/bb3bd9777604b97f664e
https://www.forguncy.com/blog/20170818_vlookup_picture

http://hirogura.com/2016/05/12/post-1793/
http://officetanaka.net/excel/function/tips/tips14.htm

QVBAでセルに値が入力されるまで待つ方法

VBAで、ある特定のセルに値が入力されるまで待機したいのですがうまくいきません。
下記のコードを書いたのですが、Excelが固まってしまいます。
ワークシートモジュールの「Worksheet_Change」イベントを使わずに
実現する方法はありますでしょうか?

Do
Sleep 1000
Loop Until Cells(1, 1).Value <> ""

よろしくおねがいいたします。

Aベストアンサー

> イベントを使わずに

それが無理です。イベントを使わずにやるには今みたいにループで常時監視しているしかなく、監視中には他の処理が全部止まってしまうのでそもそも入力ができないってことになりますから。

なのでそう言う場合はWorksheet_Changeイベントを使って、イベント内でどのセルを触ったのかを判定して処理するか無視するかを決める方法でやります。

https://www.tipsfound.com/vba/07022

QVBscriptでExcel sheetの並び替えできますか?

Excel sheetのC列に数値が入っています。VBscriptでC列を基準に(他の列のデータと一緒に))降順に並び替えしたいのですが、可能でしょうか?
可能であればスクリプトのコーディングを教えて!

Aベストアンサー

>可能であればスクリプトのコーディングを教えて!
以下のコートで可能ではあっても、リクエストが細かすぎて、vbsにはふさわしくないように感じます。以下のコードは、ブラックボックス化してしまい、条件的に成立するのは難しいし、作者の私自身でも時間が経つとメインテも利かなくなりそうです。まず、コード自体を読み直してみてください。その内容が理解できるようなら、実用に差し支えないと思います。

しかし、目で見て確認してから、実行するのは、VBAしかないように思います。

'------------------
'//ExcelOpen.vbs
Dim objFS, FileName, extension
Dim xlApp,wb
Const SHN="Sheet1" 'シート名
FileName = WScript.Arguments.Item(0)
If WScript.Arguments.Count =0 Then
MsgBox "Excelファイルをドラッグ・ドロップしてください。"
WScript.Quit
End If
Set objFS = CreateObject("Scripting.FilesystemObject")
extension = objfs.GetExtensionName(FileName)
If Left(LCase(extension),3)<>"xls" Then
MsgBox "Excelファイルではありません。",64
WScript.Quit
End If
Set xlApp =GetObject(,"Excel.Application")
If xlApp is Nothing Then
Set xlApp = CreateObject("Excel.Application")
End If
xlApp.Visible = True
Set wb= xlApp.Workbooks.Open(FileName)
Dim Rng, Sh
'xlAscending=1, xlDescending=2, xlYes =1
With wb
With .Worksheets(SHN)
Set Rng =.Range("A1").CurrentRegion
'C列
Rng.Sort Rng.cells(1,3),2,,,,,,1
End With
.Save
.Close False
wscript.quit
End With
xlApp.Quit
Set Rng =Nothing
Set Sh = Nothing
Set wb = Nothing
Set xlApp = Nothing
Set objFS = Nothing

>可能であればスクリプトのコーディングを教えて!
以下のコートで可能ではあっても、リクエストが細かすぎて、vbsにはふさわしくないように感じます。以下のコードは、ブラックボックス化してしまい、条件的に成立するのは難しいし、作者の私自身でも時間が経つとメインテも利かなくなりそうです。まず、コード自体を読み直してみてください。その内容が理解できるようなら、実用に差し支えないと思います。

しかし、目で見て確認してから、実行するのは、VBAしかないように思います。

'------------------
'//...続きを読む

QVBAのエラーについて、”実行時エラー424オブジェクトが必要です”

gooで初めて質問します、VBAのエラーについて。

エクセルのシートにActiveXのチェックボックスを挿入しマクロを
作ろうと試みています。VBAの知識がないので、サンプルを
ダウンロードして作ろうと思っています。ところが、ダウンロードした
サンプルを動作させると、”実行時エラー424オブジェクトが必要です”
というメッセージがでます。どこを修正すればよろしいでしょうか?
エクセル2007を使用しています。よろしくお願いします。
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub checkbox()
Dim コントロール As Control
Dim チェック状態 As Boolean
チェック状態 = False
For Each コントロール In Controls '質問者記入:エラーメッセージがでる。
If TypeName(コントロール) = "CheckBox" Then
If コントロール.Value = True Then
チェック状態 = True
Exit For
End If
End If
Next
If チェック状態 = False Then
MsgBox "選択されていません。"
Exit Sub
End If
End Sub

gooで初めて質問します、VBAのエラーについて。

エクセルのシートにActiveXのチェックボックスを挿入しマクロを
作ろうと試みています。VBAの知識がないので、サンプルを
ダウンロードして作ろうと思っています。ところが、ダウンロードした
サンプルを動作させると、”実行時エラー424オブジェクトが必要です”
というメッセージがでます。どこを修正すればよろしいでしょうか?
エクセル2007を使用しています。よろしくお願いします。
ーーーーーーーーーーーーーーーーーーーーーーーーーーーー...続きを読む

Aベストアンサー

私も大して分かってないのですみませんが、ご提示されたWebのサンプルコードは、「ユーザーフォーム」の上に作ったチェックボックス用かなにかのコードのようです。
シート上に作った「「ActiveXコントロールのチェックボックス」の場合は、同じチェックボックスでも少し勝手が異なるみたいです。

a:変数「コントロール」の宣言が、「Dim コントロール As OLEObject」になる。
(=「Control」型ではなく、「OLEObject型」になるみたいです。)
b:「Cntrols」が「Worksheets("sheet1").OLEObjects」になる。
c:「コントロール」や「コントロール.Value」に「Object.」がくっつく。
・・・という感じで・・・。

少し作り変えてしまいましたが、以下のコードを試すとどうなりますでしょうか?
「Sheet1」の上に作ったチェックボックスを調べていくコードです。
(たぶん、動くと思うんですけど・・・。動かなかったらごめんなさい!)

※もし「Shhet1」が作ってなければ、「Sheet1」を作って、その上に、ActiveXコントロールの「チェックボックスを2、3個、作って、実行してみてください。


'#################################################################
'チェックボックスが「ActiveXコントロール」の場合
'#################################################################

Sub checkbox02()

Dim コントロール As OLEObject
Dim チェック状態 As Boolean
Dim s_CtlName As String

チェック状態 = False


For Each コントロール In Worksheets("sheet1").OLEObjects

If TypeName(コントロール.Object) = "CheckBox" Then
If コントロール.Object.Value = True Then
チェック状態 = True
s_CtlName = コントロール.Name
Exit For
End If
End If

Next


If チェック状態 = True Then
MsgBox s_CtlName & "にチェックが入っているっぽいです。"
ElseIf チェック状態 = False Then
MsgBox "選択されていません。"
Exit Sub
End If

End Sub




ちなみにですが、チェックボックスが「フォームコントロール」のほうで作られていると、以下のような感じのようです。

d:変数「コントロール」の宣言が、「Dim コントロール As checkbox」になる。
(=「Control」型ではなく、「checkbox型」になるみたいです。)
e:「Cntrols」が「Worksheets("sheet1").CheckBoxes」になる。
f:「コントロール.Value = True」が「コントロール.Value = 1」など、数値での判別になる。
・・・という感じで・・・。

※「Sheet1」上に、「フォームコントロール」の「チェックボックスを2、3個、作って、実行してみてください。


'#################################################################
'チェックボックスが「フォームコントロール」の場合
'#################################################################

Sub checkbox03()

Dim コントロール As checkbox
Dim チェック状態 As Boolean
Dim s_CtlName As String

チェック状態 = False


For Each コントロール In Worksheets("sheet1").CheckBoxes

If TypeName(コントロール) = "CheckBox" Then
If コントロール.Value = 1 Then 'チェックONだと「1」、OFFだと「-4146」です。
チェック状態 = True
s_CtlName = コントロール.Name
Exit For
End If
End If

Next


If チェック状態 = True Then
MsgBox s_CtlName & "にチェックが入っているっぽいです。"
ElseIf チェック状態 = False Then
MsgBox "選択されていません。"
Exit Sub
End If

End Sub

私も大して分かってないのですみませんが、ご提示されたWebのサンプルコードは、「ユーザーフォーム」の上に作ったチェックボックス用かなにかのコードのようです。
シート上に作った「「ActiveXコントロールのチェックボックス」の場合は、同じチェックボックスでも少し勝手が異なるみたいです。

a:変数「コントロール」の宣言が、「Dim コントロール As OLEObject」になる。
(=「Control」型ではなく、「OLEObject型」になるみたいです。)
b:「Cntrols」が「Worksheets("sheet1").OLEObjects」になる。
c:「...続きを読む

QExcel コードでの簡単な2種類のマクロ実行について

マクロ初心者で詰まってしまっています。バージョンは2016です。

コードを利用して二種類のおなじようなマクロを実行したいです。
①1つの範囲内のセルをダブルクリックで2通→1通→ブランク
②(①とは別の)1つの範囲内のセルをダブルクリックで〇→ブランク

2つめのElseIfに対応するIfがないとのエラーが出てしまうのですが、①②をするにはどこを直せばよいのでしょうか。
なお、同様のことを③(別範囲)として行いたいです。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Cancel = True
If Intersect(Target, Range("D5:D50")) Is Nothing Then Exit Sub

Select Case Target.Value
Case ""
Target.Value = "2通"
Case "2通"
Target.Value = "1通"
Case "1通"
Target.Value = ""

Cancel = True

ElseIf Not Application.Intersect(Target, Range("E5:E50")) Is Nothing Then Exit Sub

Select Case Target.Value
Case ""
Target.Value = "〇"
Case "〇"
Target.Value = ""

End Select
End Sub

よろしくお願いいたします。

マクロ初心者で詰まってしまっています。バージョンは2016です。

コードを利用して二種類のおなじようなマクロを実行したいです。
①1つの範囲内のセルをダブルクリックで2通→1通→ブランク
②(①とは別の)1つの範囲内のセルをダブルクリックで〇→ブランク

2つめのElseIfに対応するIfがないとのエラーが出てしまうのですが、①②をするにはどこを直せばよいのでしょうか。
なお、同様のことを③(別範囲)として行いたいです。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, C...続きを読む

Aベストアンサー

こんばんは。

インデンティング(indenting-行下げ)をきちんとしていないから、エラーが見つからないのでしょうね。縦で揃えるようにして並べ直しますと、間違っていれば、Select --- End, Select, If ---End if が 揃わなくなります。
アドイン・ツールもあるのですが、今、サイトが開かないようです。
Smart Indenter という名前です。

なるべく、オリジナルを生かしています。
'//
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 If Intersect(Target, Range("D5:E50")) Is Nothing Then Exit Sub
 If Not Intersect(Target, Range("D5:D50")) Is Nothing Then
  Cancel = True
  Select Case Target.Value
   Case ""
    Target.Value = "2通"
   Case "2通"
    Target.Value = "1通"
   Case "1通"
    Target.Value = ""
  End Select
 ElseIf Not Intersect(Target, Range("E5:E50")) Is Nothing Then
  Cancel = True
  Select Case Target.Value
   Case ""
    Target.Value = "〇"
   Case "〇"
    Target.Value = ""
  End Select
 End If
End Sub

こんばんは。

インデンティング(indenting-行下げ)をきちんとしていないから、エラーが見つからないのでしょうね。縦で揃えるようにして並べ直しますと、間違っていれば、Select --- End, Select, If ---End if が 揃わなくなります。
アドイン・ツールもあるのですが、今、サイトが開かないようです。
Smart Indenter という名前です。

なるべく、オリジナルを生かしています。
'//
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 If Intersect(Target, Range("D5:E50"...続きを読む


人気Q&Aランキング