ちょっと変わったマニアな作品が集結

VBAの初級者です。
VBA[Private Sub]に以下の様なコードを作成しました。
(表示するシートを切り替えるコードです)

Private Sub *****1_Click()
Worksheets("*****").Activate
End Sub

 以上のコードをシート上に作成した図形(オートシェイプやコントロールボタン)に登録しようとすると、作成した図形を右クリックして出てくるメニュー【マクロ登録】ダイアログ画面には【Private Sub】マクロ名のリストが出て来ず、登録したくても登録できません。
(【Sub】マクロ名のリストは表示されているが?)
 どうしたら、【Private Sub】マクロを登録できるか?教えて下さい。お願いいたします。

質問者からの補足コメント

  • どう思う?

    早速の回答、ありがとうございました。
    自分でも、ご回答を追試した所、その通りでした。未知の回答で新たな知識になり助かりました。

     只、小生としては、何故【Private Sub ****()】にコードを記載したか?と言うと、それなりの理由が有ります。
     実は、VBE画面のプロジェクト画面の【Module上】では無く、【Sheet1(****)上】で(そのシートだけで利用する)コードなので、【Private Sub ****()】を、図形((オートシェイプ等)に登録したい」と思った次第です。(最初にキチンと説明しなくて申し訳有りませんでした)
     以上、追加の質問で申し訳ありませんが、回答戴ければ、助かります。どうぞ、よろしくお願いいたします。

      補足日時:2019/04/04 21:01

A 回答 (3件)

No.1です。


補足コメントの内容
・シートへのプロシージャーの記述
・「Private Sub」を図形に登録
までは想定して回答したつもりでしたが、何が解決しないのかが不明です。
>どうしてもPrivateが良いのであれば、そのあとで追記しても大丈夫なようです。
が理解できませんでしたか?
一旦「Sub・・・」で登録後、「Private Sub・・・」としても、登録されたプロシージャは名前が変更されていなければ変更されないので、Privateという属性に変更しても(少なくとも私の使用している環境では)大丈夫ですよ。
という意味で回答しております。

>【マクロ登録】ダイアログ画面には【Private Sub】マクロ名のリストが出て来ず、登録したくても登録できません。
ということでしたので、「リスト」へ表示するための手段として回答しましたが、
「Private等、リストに出てこない物を登録したい」ということでしたら「マクロ名」のところに
(ブック名!)シート名.プロシージャー名
※ブック名は省略可能。シート名.(ピリオド)プロシージャー名で、そのシートにあるプロシージャーという意味でしょう。
を手入力しても登録されます。
なお、シートに記載されたPrivateだからと言って「他のシートの図形から登録できない」わけでは無く、上記の方法で簡単に登録できますので、それほどPrivateにこだわる意味は無いように思います。

No2さんへの補足コメントでしたら、この回答は無視して構いません。
    • good
    • 0
この回答へのお礼

No.3 No.1回答者: Zincer 様

 お世話になります。
=以下の文章より、前の回答内容は、小生も追試もしましたし、理解できています。

>「Private等、リストに出てこない物を登録したい」
>書式(省略)・・・に従って、を手入力しても登録されます。
> なお、シートに記載されたPrivateだからと言って「他のシートの図形から登録できない」わけでは無く、上記の方法で簡単に登録できますので、
=しかし、回答の[書式]に従って記述して登録(OK)しても、
「マクロ'(ブック名!)シート名.プロシージャー名'を実行できません。このブックでマクロが使用できないか、またはすべてのマクロが無効になっている可能性があります。」のメッセージがでて実行できませんでした。(しかし、ブック上の他のマクロ([Module1]に記載したプロシージャ(マクロ)は[図形クリック]で問題無く実行できます。)
=その後、色々と試行実験をして見た結果、以下の様な事が判明しました。((小生の環境では・・・)
 既にある[シート名]上に記載した[Private Sub プロシージャ名]を、一旦 Private を除いて[Sub プロシージャ名]にして(当然、マクロダイアログ画面でもリストにも表示される)で図形に登録した後で、Private を付け加えた[Private Sub プロシージャ名]に変えたら、問題無く[図形クリック]でマクロが実行されました。

=正に、[第一回目の回答に尽きる]結果となりました。
>それほどPrivateにこだわる意味は無いように思います。
小生の質問にお付合い戴き、本当に、色々とありがとうございました。

お礼日時:2019/04/10 11:45

こんばんは!



オートシェイプにマクロを登録する場合は
挿入したオートシェイプ上で右クリック → マクロの登録 → 新規作成
これでVBE画面に

Sub 挿入したオートシェイプ名_Click()

End Sub

と表示されますので、カーソルが点滅しているところに
必要なコードを記載するだけです。

※ フォームコントロールのコマンドボタンの場合は挿入すれば
VBE画面が表示されますのですぐにコード記載。

ActiveXコントロールのコマンドボタンでは
挿入したコマンドボタンをダブルクリック!
これでコード記載が可能になります。m(_ _)m
    • good
    • 0

先ずは「Private」を除いて「Sub *****1_Click()」としておき、質問中の手順で登録。


どうしてもPrivateが良いのであれば、そのあとで追記しても大丈夫なようです。
    • good
    • 0

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

このQ&Aを見た人はこんなQ&Aも見ています

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

QExcelのVBAで他のブックから転記したい

まだVBAの勉強始めたばかりですが、ExcelのVBAを使ってデータの検索と転記を行うプログラムを作っています。

やりたいことは、多数の同じ作りのファイル(Aブックとします)のB2~E2の内容を
Bブック内で検索を行い該当行がなければ、最後の行の下(最下行)に転記をし、
該当行があれば、同じ行のF2~G2に転記をすることです。

各ブックの構成です。

参照先:Aブック
Aブック内に別のシートがあり、その中から必要な事項をまとめた「転記用シート」があります。
その「転記用」シートにB2~I2まで数式が入力されています。

B2 到着日 数式:=IF(入力シート!S2="","",入力シート!S2)   セルの内容:3/18
C2 お名前 数式:=IF(入力シート!D6="","",入力シート!D6)   セルの内容:日本 太郎
D2 品名  数式:=IF(入力シート!E10="","",入力シート!E10)  セルの内容:AB123
E2 番号  数式:=IF(入力シート!O10="","",入力シート!O10)  セルの内容:AA123456


転記先:Bブック
シート名:新データシート
既に1000行ほど入力されています。
シートは、3行目がタイトル行で、4行目から実際のデータが入力されています。

No. 到着日  お名前    品名   番号     見積  金額 
A  B      C      D     E      F    G  
1  3/8   日本 太郎  ABC123  AA111111  100   100
2  3/11   東京 花子  BCD123  BB222222  500   600
3  3/11   大阪 一郎  CDE123  CC333333    0    0
4  3/11   日本 太郎  ABC123  AA111111  100   100
5  3/12   世界 二郎  BCD123  BB222223

Bブックには、AブックのC2、D2、E2と同じ値が既にあり、B2の日付のみ違うことがあります。
日付が違う場合は、一致していないと見なし、BブックにB2~G2まで転記をしたいのです。
また、日付をキーにすることもできません。

つまり、AブックのB2~E2がBブックにあったら、AブックのF2、G2をBブックの該当行に
転記し、条件に一致しない場合は、Bブックの最下行に追記したいのです。

なお、「For j = 4 To LastRow」
のところにDebug.printを挿入しました。
データが既に入力されていても「4」と表示され、
最下行に追記されてしまいました。

以下が、実際に自分でVBAで書いてみたのですが、
意図したとおりの結果を得ることができません。

どうか教えてください。
-----------------
Sub まとめtest()

Dim j As Long
Dim LastRow As Long

Dim s1 As Worksheet 'Aブックの「転記用」シート
Dim s2 As Worksheet 'Bブックの「新データ」シート

Dim objWbk As Workbook 'Aブック
Dim bk_name As Workbook 'Bブック

ThisWorkbook.Activate 'Aブックをアクティブ

Application.ScreenUpdating = False

Set objWbk = ActiveWorkbook
Set bk_name = Workbooks.Open("C:\報告書\記録帳.xlsx")

Set s1 = objWbk.Worksheets("転記用")
Set s2 = bk_name.Worksheets("新データ")

LastRow = s2.Cells(Rows.Count, "B").End(xlUp).Row

For j = 4 To LastRow

If Range("B" & j).Value = s1.Range("B" & 2).Value _
And Range("C" & j).Value = s1.Range("C" & 2).Value _
And Range("D" & j).Value = s1.Range("D" & 2).Value _
And Range("E" & j).Value = s1.Range("E" & 2).Value Then

Range("F" & j).Value = s1.Range("F" & 2).Value
Range("G" & j).Value = s1.Range("G" & 2).Value

Else
s1.Range("B2:F2").Copy
s2.Range("B" & LastRow + 1).PasteSpecial Paste:=xlPasteValues

Exit For
End If
Next

Set s1 = Nothing
Set s2 = Nothing

Application.ScreenUpdating = True

End Sub
----------------------------

※以前同じような内容で質問をしましたが、
条件に変更があったため、再度質問をいたしました。

まだVBAの勉強始めたばかりですが、ExcelのVBAを使ってデータの検索と転記を行うプログラムを作っています。

やりたいことは、多数の同じ作りのファイル(Aブックとします)のB2~E2の内容を
Bブック内で検索を行い該当行がなければ、最後の行の下(最下行)に転記をし、
該当行があれば、同じ行のF2~G2に転記をすることです。

各ブックの構成です。

参照先:Aブック
Aブック内に別のシートがあり、その中から必要な事項をまとめた「転記用シート」があります。
その「転記用」シートにB2~I2まで数式が...続きを読む

Aベストアンサー

もしかして,Bシートの”3/28”のところがB2セルではありませんか?
For j = 4 To LastRow +1にすればうまくいきました。
あと,IF文の所も直しておきました。
FOR文を下の通りにすればうまくいきましたよ。

---------------------------------
For j = 4 To LastRow + 1

If s2.Range("B" & j).Value = s1.Range("B" & 2).Value _
And s2.Range("C" & j).Value = s1.Range("C" & 2).Value _
And s2.Range("D" & j).Value = s1.Range("D" & 2).Value _
And s2.Range("E" & j).Value = s1.Range("E" & 2).Value Then

s2.Range("F" & j).Value = s1.Range("F" & 2).Value
s2.Range("G" & j).Value = s1.Range("G" & 2).Value

Exit For
End If

If j = LastRow + 1 Then
s1.Range("B2:F2").Copy
s2.Range("B" & LastRow + 1).PasteSpecial Paste:=xlPasteValues
End If

Next
-------------------------------------------------

もしかして,Bシートの”3/28”のところがB2セルではありませんか?
For j = 4 To LastRow +1にすればうまくいきました。
あと,IF文の所も直しておきました。
FOR文を下の通りにすればうまくいきましたよ。

---------------------------------
For j = 4 To LastRow + 1

If s2.Range("B" & j).Value = s1.Range("B" & 2).Value _
And s2.Range("C" & j).Value = s1.Range("C" & 2).Value _
And s2.Range("D" & j).Value = s1.Range("D" & 2).Value _
And s2.Range("E" & j).Value = s1.Range("E" & 2).Value The...続きを読む

QVBA/GetTickCountの49.7日の境目を跨ぐ時の処理

たまたまGetTickCountの49.7日の境目を通過したと思しき値の急変を経験しました。
ログで処理時間を記録する必要があり、GetTickCountを使用していましたが、境目を意識したプログラムになっていません、下記にて修正を加えるつもりです。

『メイン側』
Dim arg_apiS As Long
arg_apiS = GetTickCount
・・・・処理・・・・
Dim arg_apiN As Long
Dim arg_subTime As Long
arg_apiN = GetTickCount
Call ******(arg_apiS, arg_apiN, arg_subTime)
select case arg_subRslt
・・・・・・
『CallSub側』
Sub ******(ByRef arg_apiS As Long,arg_apiN As Long, arg_subTime As Long)
Select Case True
Case arg_apiS < arg_apiN
arg_subRslt = arg_apiN - arg_apiS
Case arg_apiS < arg_apiN
arg_subRslt = (2 ^ 32 - arg_apiS) + arg_apiN
End Select

単純動作は確認OKですが、境目の模擬的発生もできず・・・
境目を跨いだ状態でも、正常に動くのか確認したく質問しました。
よろしくお願いします。

たまたまGetTickCountの49.7日の境目を通過したと思しき値の急変を経験しました。
ログで処理時間を記録する必要があり、GetTickCountを使用していましたが、境目を意識したプログラムになっていません、下記にて修正を加えるつもりです。

『メイン側』
Dim arg_apiS As Long
arg_apiS = GetTickCount
・・・・処理・・・・
Dim arg_apiN As Long
Dim arg_subTime As Long
arg_apiN = GetTickCount
Call ******(arg_apiS, arg_apiN, arg_subTime)
select case arg_subRslt
・・・・・・
『CallSub側...続きを読む

Aベストアンサー

Case arg_apiS < arg_apiNはまずいですね。
arg_apiS = 49.6日
arg_apiN = 49.8日(オーバーフローして0.1日となる)
この場合に意図した動作になりません。

このサブルーチンの中でもう一度GetTickCountで時間を取得します。仮にこの時間をXとしましょう。
S = X - arg_apiS
N = X - arg_apiN
このSとNを比較すれば49.7日の境目の影響を受けません。検証してみましょう。
arg_apiS = 49.6日
arg_apiN = 0.1日(49.8日)
X = 1.0日

S = X - arg_apiS = 1.1日前(-48.7日のアンダーフロー)
N = X - arg_apiN = 0.9日前

比較すればarg_apiSの方が古いと正しく判断できます。

これが基本的なオーバーフロー(49.7日)問題の回避方法です。

Q【Excel VBA】繰り返し処理ができない

VBAは超初心者です。始めたばかりでなかなかのみこめず、
独学で解決できなくなり、ご教示いただきたく思います。

Excel VBAで、A列で表示させた値(こちらは数式バーには計算式が入っています)を、
隣のB列(B2からA列に値が入っている行まで)に特定の文字列と特定の文字列の間の値を表示させたいのです。

値は
A2~A10
まで入っています。

1行目は成功しました。
2行目から、A3以降の値が、転記されないのです。

分かりにくいかもしれませんが、画像を貼ります。(画像は完成させたいイメージ図です)
説明がうまくなく、申し訳ございません。どなたか原因等ご教示いただけたら
幸いです。宜しくお願い致します。


***********************
Sub 転記()

Dim S2 As Worksheet
Dim myStr As Variant
Dim myStr2 As Variant
Dim iRowI As Integer
Dim iLastRow As Integer

Set S2 = Worksheets("食べ物") '今回使用するシート

'"食べ物"シートのA列の最終行を取得する("抽出"列の最終行)
iLastRow = S2.Range("A2").SpecialCells(xlLastCell).Row

'最終データ行までループ処理させる
For iRowI = 2 To iLastRow

'文字列処理
myStr2 = S2.Cells(2, 1).Value
If S2.Cells(2, 2).Value = Mid(myStr2, InStr(myStr2, ")") + 1, InStr(myStr2, "WEEKLY") - InStr(myStr2, ")") - 2) Then
End If

Next

End Sub

VBAは超初心者です。始めたばかりでなかなかのみこめず、
独学で解決できなくなり、ご教示いただきたく思います。

Excel VBAで、A列で表示させた値(こちらは数式バーには計算式が入っています)を、
隣のB列(B2からA列に値が入っている行まで)に特定の文字列と特定の文字列の間の値を表示させたいのです。

値は
A2~A10
まで入っています。

1行目は成功しました。
2行目から、A3以降の値が、転記されないのです。

分かりにくいかもしれませんが、画像を貼ります。(画像は完成させたいイメージ図で...続きを読む

Aベストアンサー

こんばんは。

(1)いちご FOOD(@@@@)
>Mid(myStr2, InStr(myStr2, ")") + 1, ここは分かりますが、
>InStr(myStr2, "WEEKLY") - InStr(myStr2, ")") - 2)
ここが何をしているのかよくわからないですね。元のデータと違うのではないでしょうか?
画像からみる印象では、空白を探すという手もあるのですが、空白が必ずしもあるとは限らないわけです。
FOOD を探すとか、

例えば、こういうことになります。
For iRowI = 2 To iLastRow
 '文字列処理
  myStr =S2 .Cells(iRowI, 1).Value
  S2.Cells(iRowI, 2).Value = Mid(myStr, InStr(myStr, ")") + 1, InStr(myStr, ")") - InStr(myStr, "FOOD"))
Next

Q【VBA】フォルダ内の複数Excelのセルと列をコピー

お世話になります。
Excel2016にて作業をしておりますが、上手くいかないのでお知恵をお貸しいただきたく質問いたします。

【概要】
あるフォルダ内にある複数のExcelファイルから、特定のセル及び列を1つのExcelファイルに集約します。

【詳細】
1.あるフォルダ内に複数のExcelファイルがあります。
 いずれも「〜.xlsx」の形式で、ファイル数は日によって異なります。
2.これらのExcelファイルの、Sheet1のA1セルとA2セル、Sheet2のA列、C列を抽出して、1つのExcelファイルに貼り付けます。
3.列の長さはファイルによって異なります。
4.貼付→次の列へ移動、というサイクルをフォルダ内のExcelファイルの数だけ繰り返します。
5.集約したExcelファイルのイメージは以下の通りです。

    A列 B列 C列 D列 E列……
1行目 A1 A2  A1 A2
2行目 A列 C列 A列 C列
3行目 A列 C列 A列 C列
4行目 A列 C列 A列 C列
5行目 A列 C列 A列 C列
     ↑    ↑
   (1.xlsx)(2.xlsx)

「列を集約」と「セルを集約」を同時に解決できずにおります。
ご助言をいただけますと大変ありがたいです。よろしくお願いいたします。

お世話になります。
Excel2016にて作業をしておりますが、上手くいかないのでお知恵をお貸しいただきたく質問いたします。

【概要】
あるフォルダ内にある複数のExcelファイルから、特定のセル及び列を1つのExcelファイルに集約します。

【詳細】
1.あるフォルダ内に複数のExcelファイルがあります。
 いずれも「〜.xlsx」の形式で、ファイル数は日によって異なります。
2.これらのExcelファイルの、Sheet1のA1セルとA2セル、Sheet2のA列、C列を抽出して、1つのExcelファイルに貼り付けます。
3.列の...続きを読む

Aベストアンサー

こんにちは!

各ブックのSheet2のA・C列は1行目からでよいのでしょうかね?
尚、Sheet2のC列最終行とA列の最終行は同じ行数だとしています。

一例です。
コード記載ブックのSheet1に表示するとします。
標準モジュールにしてください。

Sub Sample1()
 Dim myPath As String, fN As String
 Dim wB As Workbook, wS1 As Worksheet, wS2 As Worksheet
 Dim cnt As Long, lastRow As Long, myCol As Long
  myPath = "保存場所のパス" & "\"
  fN = Dir(myPath & "*xlsx")
   Do Until fN = ""
    Workbooks.Open myPath & fN
     Set wB = ActiveWorkbook
     Set wS1 = wB.Worksheets("Sheet1")
     Set wS2 = wB.Worksheets("Sheet2")
      cnt = cnt + 1
      myCol = cnt * 2 - 1
       With ThisWorkbook.Worksheets("Sheet1")
        .Cells(1, myCol) = wS1.Range("A1")
        .Cells(1, myCol + 1) = wS1.Range("A2")
        lastRow = wS2.Cells(Rows.Count, "A").End(xlUp).Row
         Range(wS2.Cells(1, "A"), wS2.Cells(lastRow, "A")).Copy
          .Cells(2, myCol).PasteSpecial Paste:=xlPasteValues
         Range(wS2.Cells(1, "C"), wS2.Cells(lastRow, "C")).Copy
          .Cells(2, myCol + 1).PasteSpecial Paste:=xlPasteValues
       End With
      wB.Close
     fN = Dir()
   Loop
  MsgBox "完了"
End Sub

こんな感じではどうでしょうか?

※ コード内の「保存場所のパス」は実際のパスにしてください。m(_ _)m

こんにちは!

各ブックのSheet2のA・C列は1行目からでよいのでしょうかね?
尚、Sheet2のC列最終行とA列の最終行は同じ行数だとしています。

一例です。
コード記載ブックのSheet1に表示するとします。
標準モジュールにしてください。

Sub Sample1()
 Dim myPath As String, fN As String
 Dim wB As Workbook, wS1 As Worksheet, wS2 As Worksheet
 Dim cnt As Long, lastRow As Long, myCol As Long
  myPath = "保存場所のパス" & "\"
  fN = Dir(myPath & "*xlsx")
   Do Until fN = ""
   ...続きを読む

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

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で配列を繰り返し宣言したい

配列を宣言する方法が分からなくて困ってます。
やりたいことは以下のような感じです。
Dim ARR_1 (300,10) AS Double
Dim ARR_2 (300,10) AS Double
Dim ARR_3 (300,10) AS Double

Dim ARR_i (300,10) AS Double
iは変数で50~200の値を取ります。
一つ一つ宣言していると大変な手間がかかってしまうので、繰り返し文などで簡単にできる方法があれば教えて頂けると助かります。

Aベストアンサー

こんにちは

「変数名を変えながら」というのは無理だと思いますが、元々そういうときの為に配列という概念が存在しているのではないでしょうか?
3次元配列にして
 ARR( i, 300, 10)
とかではダメなのでしょうか?

宣言するだけなら
 Dim ARR(50 To 200, 1 To 300, 1 To 10) As Double
とか。

あるいは、ご質問内容からは少し外れますが、Variantの1次元配列を作成しておいて、その各値に配列を格納するようなことも可能でしょう。
 Dim arr(200) As Variant
 arr(1) = Array("1", "2", "3")
 arr(2) = Array("A", "B", "V")
  ・・・

Q【VBA】複数条件のVLOOKUP

いつもこちらの識者の方々にはお世話になっています。
VBAの質問です。
この表のsheet1の、年度・入数の項目が一致しているものをsheet2から探し、sheet1ののG2セル以降に判定結果をあてはめていきたいのですが難儀しています。
作業用の列を作らずにやる場合、どういった構文が適していますでしょうか。
コードをご教授いただけませんでしょうか。読み解いてみますのでよろしくお願いいたします。

Aベストアンサー

こんにちは
VBAでの一例です。

Sub Sample()
Dim data, d1, d2
Dim rw As Long, i As Long

With Worksheets("Sheet2")
 rw = .Cells(Rows.Count, 4).End(xlUp).Row
 data = Range(.Cells(3, 4), .Cells(rw, 6)).Value
End With

With Worksheets("Sheet1")
 For rw = 3 To .Cells(Rows.Count, 2).End(xlUp).Row
  .Cells(rw, 7).ClearContents
  d1 = .Cells(rw, 2).Value
  d2 = .Cells(rw, 4).Value

  For i = 1 To UBound(data)
   If d1 = data(i, 1) And d2 = data(i, 2) Then
    .Cells(rw, 7).Value = data(i, 3)
    Exit For
   End If
  Next i
 Next rw
End With

End Sub

こんにちは
VBAでの一例です。

Sub Sample()
Dim data, d1, d2
Dim rw As Long, i As Long

With Worksheets("Sheet2")
 rw = .Cells(Rows.Count, 4).End(xlUp).Row
 data = Range(.Cells(3, 4), .Cells(rw, 6)).Value
End With

With Worksheets("Sheet1")
 For rw = 3 To .Cells(Rows.Count, 2).End(xlUp).Row
  .Cells(rw, 7).ClearContents
  d1 = .Cells(rw, 2).Value
  d2 = .Cells(rw, 4).Value

  For i = 1 To UBound(data)
   If d1 = data(i, 1) And d2 = data(i, 2) Then
    .Cel...続きを読む

QVBAのVLOOKUPで複数列を検索できますでしょうか。

Sheet1のA列に検索値として都道府県コードを入力し、Sheet2の検索範囲としてA列都道府県コード、B列都道府県名、C列県庁所在地から、都道府県名と県庁所在地を検索するのに苦戦しています。
現状B列都道府県名を検索する下記コードまではたどりつきましたが、C列県庁所在地を表示することができません。

Sub vlookup()
Dim workSh, prefSh As Worksheet
Set workSh = ThisWorkbook.Worksheets("Sheet1")
Set prefSh = ThisWorkbook.Worksheets("Sheet2")

'検索範囲を指定する
Dim prefRng As Range
Set prefRng = Range(prefSh.Cells(2, 1), prefSh.Cells(48, 2))

Dim workEndR, workTmpR As Long, tmpStr
workEndR = workSh.Cells(Rows.Count, 1).End(xlUp).Row

'VLookupでSheet1に入力された都道府県コードから、Sheet2の指定した範囲から都道府県を求める
'発見できなかった場合エラーとなりマクロが停止するので、On Errorステートメントで制御する
For workTmpR = 2 To workEndR
tmpStr = workSh.Cells(workTmpR, 1).Value
On Error Resume Next
workSh.Cells(workTmpR, 2).Value = Application.vlookup(tmpStr, prefRng, 2, False)
If Err <> 0 Then
workSh.Cells(workTmpR, 2).Value = "ERROR"
Err.Clear
End If
Next
End Sub

お知恵をお貸しください。よろしくお願いいたします。

Sheet1のA列に検索値として都道府県コードを入力し、Sheet2の検索範囲としてA列都道府県コード、B列都道府県名、C列県庁所在地から、都道府県名と県庁所在地を検索するのに苦戦しています。
現状B列都道府県名を検索する下記コードまではたどりつきましたが、C列県庁所在地を表示することができません。

Sub vlookup()
Dim workSh, prefSh As Worksheet
Set workSh = ThisWorkbook.Worksheets("Sheet1")
Set prefSh = ThisWorkbook.Worksheets("Sheet2")

'検索範囲を指定する
Dim...続きを読む

Aベストアンサー

こんばんは

今までのご回答も拝見しましたが、C列にも県庁所在地を表示したいということだけであれば、
On Error 以下をこのように修正するだけで十分かと思います。

workSh.Cells(workTmpR, 2).Value = Application.vlookup(tmpStr, prefRng, 2, False)
workSh.Cells(workTmpR, 3).Value = Application.vlookup(tmpStr, prefRng, 3, False)
If Err <> 0 Then
workSh.Cells(workTmpR, 2).Value = "ERROR"
workSh.Cells(workTmpR, 3).Value = "ERROR"

まず、Vlookup関数は
・検索対象を(tmpStr)
・指定した検索範囲(prefRng)の左端列から検索、行を特定し
・左端列から指定した数の列数(2または3)のデータを戻り値として返す
という関数です。

他の方が関数の意味を考えるようご指摘なさっているのは、これをきちんと理解していれば
この修正はもっとも単純に思いつくことであろうということからでしょう。

また、行う作業がこれだけならば、ぶっちゃけた話マクロを組む必要性も薄いかと思います。
当然ながら質問者様が実はもっと複雑なマクロを組むことを考えておられ、今回のご質問は
そのほんの一部に過ぎない場合はご参考にして頂ければ幸いです。

余談ですが、他の方も書かれているとおり、On Error 処理はエラーをマスクしてしまうため、
マクロがうまく動いているように見えてしまいます。個人的にはあまり使わないようにしています。

たとえばこのケースで言うならば、

If WorksheetFunction.CountIf(prefRng.Resize(, 1), tmpStr) > 0 Then

といった具合に、tmpStrの有無をエラーではなくCountIfの戻り値で判断させるという方法もあります。
こうするとエラーが起きた箇所でマクロが「きちんと」とまりますので、どこに問題があるか等を確認
しながら進めることが可能です。

こんばんは

今までのご回答も拝見しましたが、C列にも県庁所在地を表示したいということだけであれば、
On Error 以下をこのように修正するだけで十分かと思います。

workSh.Cells(workTmpR, 2).Value = Application.vlookup(tmpStr, prefRng, 2, False)
workSh.Cells(workTmpR, 3).Value = Application.vlookup(tmpStr, prefRng, 3, False)
If Err <> 0 Then
workSh.Cells(workTmpR, 2).Value = "ERROR"
workSh.Cells(workTmpR, 3).Value = "ERROR"

まず、Vlookup関数は
・検索対象を(tmpStr)
・指定した検索...続きを読む

Q「-2147012889」というエラーでマクロが止まる

先日、「そのドメインがSSL化してるかどうかをマクロで調べる」という、
質問をさせていただきました。

そこで書いていただいたマクロは、順調に動いていました。

'//
Sub TestSSLChecker2()
 Dim objHttp As Object
 Dim nURL As String
 Dim strURL As String
 Dim i As Long, f As String, l As String
 Dim Lastrow As Long, getLine As Long
 Set objHttp = CreateObject("WinHttp.WinHttpRequest.5.1")

 On Error GoTo ErrHandler
 'A1から
 getLine = Cells(Rows.Count, 2).End(xlUp).Row
 Lastrow = Cells(Rows.Count, 1).End(xlUp).Row
 If getLine = Lastrow Then MsgBox "既に終わっているか、データがないです。", vbExclamation: Exit Sub
 If getLine < Lastrow And Cells(1, 2).Value <> "" Then
  getLine = getLine + 1
 Else
  getLine = 1 '最初の行が1行目からの場合
 End If
 For i = getLine To Lastrow
  strURL = LCase(Trim(Cells(i, 1).Value)) 'A列の登録URL
  strURL = Replace(strURL, "https:", "http:")
  If strURL Like "http*" Then
   objHttp.Open "GET", strURL, False
   objHttp.Send
   DoEvents 'ESC割り込み可能にする
   With objHttp
    If .Status = 200 Then
     nURL = .Option(1) 'WinHttpRequestOption_URL
     f = Mid(strURL, 1, InStr(strURL, "://"))
     l = Mid(nURL, 1, InStr(nURL, "://"))
     If nURL = "" Then
      Cells(i, 2).Value = "no URL"
     ElseIf nURL <> "" Then
      If LCase(f) = LCase(l) Then
       Cells(i, 2).Value = "non SSL"
      Else
       Cells(i, 2).Value = "https"
      End If
     End If
    Else
     Cells(i, 2).Value = "Err:" & .Status
    End If
   End With
  End If
Endline:
  nURL = ""
  strURL = ""
 Next i
 MsgBox "Finished"
 Exit Sub
ErrHandler:
 If Err() <> 0 Then
  Cells(i, 2).Value = Err.Number 'マイナスになるのは外部エラー
  GoTo Endline
 End If
End Sub

順調に動いていたのですが、頻繁にエラーで止まるようになってきました。
エラーの時にはセルに、「-2147012889」という数値が記入されます。

この「-2147012889」を避けて、
エラーが出さずに、マクロを動かすことは可能でしょうか?

どのような記述で、避けることができるのでしょうか?
よろしくお願いいたします。

先日、「そのドメインがSSL化してるかどうかをマクロで調べる」という、
質問をさせていただきました。

そこで書いていただいたマクロは、順調に動いていました。

'//
Sub TestSSLChecker2()
 Dim objHttp As Object
 Dim nURL As String
 Dim strURL As String
 Dim i As Long, f As String, l As String
 Dim Lastrow As Long, getLine As Long
 Set objHttp = CreateObject("WinHttp.WinHttpRequest.5.1")

 On Error GoTo ErrHandler
 'A1から
 getLine = Cells(Rows.Count, 2).En...続きを読む

Aベストアンサー

No.1の回答者です。
「-2147012889」の数字が、本日、WiFiのエラーで出てきて考えたのですが、回線そのものの切断のようですね。一旦、エラーが出てくると、繰り返しなのか、復旧するまでにしばらく時間が掛かってしまいます。回線そのものを、有線LANにしたらと考えましたが、それは可能でしょうか。

今の所、IEオブジェクトを使ってやる方法を考えてはいるのですが、エラーでも、内部で済むのではないかと思います。しかし、いかんせん、ものすごく遅いのです。それにコードがややこしい上に、できるという保証はありません。他の良い手立てを思いつかないのです。ただ、Excel 2016ですと、まだ残されている方法があるかもしれません。


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング