人に聞けない痔の悩み、これでスッキリ >>

エクセルVBAについて教えてください!

右クリックで表示されるメニューにマクロの実行を登録したいのですが、表示されるのは特定のブックを、開いた時のみ表示され、そのブックを閉じると表示されないようにしたいのですが、どのようなコードを、入れたら良いでしょうか?
また、そのコードを入力するモジュールはthis work bookに入力になりますか?標準モジュールに入れて出来る方法があればそちらも教えて下さい。
わかりにくい説明ですが、よろしくお願いします!!!

A 回答 (2件)

すでに、No.1さんのご紹介がありますが、Office Tanaka の田中さんのコードは関心ししませんね。

起動する前に、Reset や Delete を入れるという建前が必要です。

'//標準モジュール
Sub Auto_Open
   Call RightClickMenuAccess '直接中身を書いても良い。
End Sub

Sub RightClickMenuAccess()
'Dim i As Integer
'右クリックメニュー登録
With Application.CommandBars("CELL")
  .Reset '一旦元に戻す
  With .Controls.Add _
   (Type:=msoControlButton, Before:=1, Temporary:=True) '<=恒久的に残らない-temporary
   .BeginGroup = False
   .Caption = "マクロ名"
   .OnAction = "xxxxxxx" '実際のマクロ名
  End With
End With
End Sub

Private Sub xxxxxxx() 'Private にすると、右クリックのみの呼び出しになります。
'実際の作業マクロ

End Sub

Sub Auto_Close()
  Application.CommandBars("CELL").Reset '一旦元に戻す
End Sub
'-------------------------------
>thisworkbookに入力になりますか?標準モジュールに入れて出来る方法があればそちらも教えて下さい。

ThisWorkbook_Open()/ThisWorkbook_Close() でも同じです。

ThisWorkbook_Openだとしても、  Call RightClickMenuAccess '標準モジュールのマクロを呼び出し1行でよいのです。

ところで、こういうスタイルは、旧設定のようなのです。
https://www.rondebruin.nl/win/s6/win001.htm

新しい設定の仕方(2010以上)は、Bruin氏のように、XML にコードを入れる方法が好まれるようです。
https://www.rondebruin.nl/win/s2/win014.htm

ただ、この方のXMLコードは日本語(2 byte文字)を埋め込むようには出来ていませんので

<?xml version="1.0" encoding="UTF-8"?> // 一行を加えて対応させる
<customUI xmlns="http://schemas.microsoft.com/office/2009/07/cust …
<contextMenus>

サンプルは Downloads にあります。(2010-2016)

なお、長い間手付かずのUI XMLエディタがMicrosoft から更新されました。Custom UI Editor for Microsft Office Version 4.0.64(メニュー非日本語、2 byte文字対応)、またOffice 右クリックメニュー登録アプリもありますが、日本語(2 byte文字)に完全対応していない模様です。ちょっとむつかしそうですが、やってみると病みつきなるかもしれません。
    • good
    • 0
この回答へのお礼

とても、詳しく教えて頂き、ありがとうございます!!
無事、できました!
以前、thisworkbookにコードを入力した際に、シート間のコピペができなくなったことがあり、標準モジュールに出来ればと思っていたのと、他のエクセルブックには影響させたくなかったので、この方法を教えて頂き、本当に助かりました。ありがとうございました!

お礼日時:2019/02/27 12:24

こんにちは



>特定のブックを、開いた時のみ表示され、
>そのブックを閉じると表示されないようにしたい
確認してはいませんが、当該WorkbookのOpenイベントで右クリックメニューへの登録、Closeイベントで削除を行うようにしておけば実現できるものと思います。

右クリックメニューへのマクロの登録/削除については、以下あたりをご参考に
https://www.atmarkit.co.jp/ait/articles/1408/25/ …
http://officetanaka.net/excel/vba/tips/tips30.htm
    • good
    • 0
この回答へのお礼

ありがとうございます!!サイトにのっていた、サブメニューの追加方法も知りたかったので、とても助かりました!!!

お礼日時:2019/02/27 12:18

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

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

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

Q4142から653347と飛んでます。 これを4143からちゃんと並ぶにはどうすればいいでしょうか?

4142から653347と飛んでます。
これを4143からちゃんと並ぶにはどうすればいいでしょうか?

Aベストアンサー

これ、9から70に飛んでるよね。

①シート全体を選択
②どの行でもいいので右クリック
③再表示を選択

開いたかな?

Qエクセル リストと完全一致するセルに色をつける

シート1のA列とB列に
aaa ccc
bbb ggg
ccc kkk
ddd ooo
と言うリストがあって、A1〜A4はAチーム、B1〜B4まではBチームと名前を付けています
シート2にAチームのリスト4個が続いているものがあればセルを赤、Bチームのリスト4個が続いているものがあればセルを黄色に塗りたいです
AチームとBチームの中には同じ品番がある時もあります
条件付き書式で設定は出来るでしょうか?

Aベストアンサー

(´・ω・`)
”○” の数を数えるんじゃないんだよなあ。

・・・本題・・・

条件付き書式ですよね。

シート2のリストの並び順は
 aaa
 ccc
 bbb
 ddd
では「Aチーム」と認識しないという事でよろしいでしょうか?
ならば、とても簡単です。

シート2の一覧において、

 判定するセル1
 判定するセル2
 判定するセル3
 色を付けるセル
 判定するセル4
 判定するセル5
 判定するセル6

という範囲について調べれば良いという事。

 判定するセル1
 判定するセル2
 判定するセル3
 色を付けるセル

 判定するセル2
 判定するセル3
 色を付けるセル
 判定するセル4

 判定するセル3
 色を付けるセル
 判定するセル4
 判定するセル5

 色を付けるセル
 判定するセル4
 判定するセル5
 判定するセル6

の4パターンについてそれぞれ調べれば良いだけ。

自分なら
 aaa-bbb-ccc-ddd
のようにシート1から文字列を作り、それが調べるセルで同じパターンになるかを調べます。
シート1はA5セルから、シート2はA11セルからデータが入力されているなら、

 シート1!A5 & シート1!A6 & シート1!A7 & シート1!A8 = A11 & A12 & A13 & A14
 シート1!A5 & シート1!A6 & シート1!A7 & シート1!A8 = A12 & A13 & A14 & A15
 シート1!A5 & シート1!A6 & シート1!A7 & シート1!A8 = A13 & A14 & A15 & A16
 シート1!A5 & シート1!A6 & シート1!A7 & シート1!A8 = A14 & A15 & A16 & A17

という条件になる。
この4つのうちの一つでも条件を満たせばセルに赤色を付ければいい。
「Bチーム」についても同様にすればいいので、
この場合、8つの条件式を設定することになります。

面倒でもこの考え方ができていないと、ちょっと条件が変わっただけで対処できずに終わります。
冒頭で「並び順」について書きましたが、並び順がシート1のリストの通りでなくとも色を付けたい場合でも、この考え方は必要ということです。

・・・
ちなみに厄介なのが、どちらのチームにも「ccc」がいるというところかな。
これが無ければ違う方法でシンプルにできるんですけどねえ。

(´・ω・`)
”○” の数を数えるんじゃないんだよなあ。

・・・本題・・・

条件付き書式ですよね。

シート2のリストの並び順は
 aaa
 ccc
 bbb
 ddd
では「Aチーム」と認識しないという事でよろしいでしょうか?
ならば、とても簡単です。

シート2の一覧において、

 判定するセル1
 判定するセル2
 判定するセル3
 色を付けるセル
 判定するセル4
 判定するセル5
 判定するセル6

という範囲について調べれば良いという事。

 判定するセル1
 判定するセル2
 判定するセル3
 色を付け...続きを読む

QCSVで文字化けしてしまうのを直すマクロ

いつもお世話になっております。
Excel2013を使用していますので
アドバイスどうぞよろしくお願いします。

"ファイル名"というシートのA列2行目からCSVファイルのファイル名が書いてあります。
日によるのですが、だいたい5~10件程度です。
そしてこのCSVファイルがくせ者でファイルを開くと文字化けを起こしてしまいます。下記のサイトを参考にマクロを作ったのですが、文字化けはしないものの文字に必ず""がついてしまい、また一行しか転記されません。

http://officetanaka.net/excel/vba/file/file10.htm

例 空白→""、 神奈川→"神奈川"

やりたいこととしてはファイル名とあるシートのA列2行目に書いてあるCSVファイルを開き、文字化けを直してSheet1にデータを表示させ、それをファイル名が書いてある最終行まで行いたいです。

Sub macro()
Dim i1 As Long, x As Long
Rbook As Workbook
Rsheet As Worksheet, Ssheet As Worksheet
Set Rbook = ThisWorkbook

Sheets("ファイル名").Select
Set Rsheet = Rbook.Worksheets("ファイル名")
For i1 = 2 To 10
If Rsheet.Cells(i1, 1).Value <> "" Then
Sheets("SHEET1").Select ’表示させるシート
Set Ssheet = Rbook.Worksheets("SHEET1")
Ssheet.Cells.Clear
Ssheet.Range("A1").Select

’文字化けを直す
Dim buf As String, Target As String, i1 As Long
Dim tmp As Variant, j As Long
Target = "¥アドレス" & Ssheet.Cells(i, 1).Value
With CreateObject("ADODB.Stream")
.Charset = "UTF-8"
.Open
.LoadFromFile Target
Do Until .EOS
buf = .ReadText(-2)
i = i + 1
tmp = Split(buf, ",")
For j = 0 To UBound(tmp)
Cells(i, j + 1) = tmp(j)
Next j
Loop
.Close
End With

’別のマクロ実行

End if
Next i1

’2行目、3行目と続く

End Sub

どうぞよろしくお願い致します。

いつもお世話になっております。
Excel2013を使用していますので
アドバイスどうぞよろしくお願いします。

"ファイル名"というシートのA列2行目からCSVファイルのファイル名が書いてあります。
日によるのですが、だいたい5~10件程度です。
そしてこのCSVファイルがくせ者でファイルを開くと文字化けを起こしてしまいます。下記のサイトを参考にマクロを作ったのですが、文字化けはしないものの文字に必ず""がついてしまい、また一行しか転記されません。

http://officetanaka.net/excel/vba/file/fil...続きを読む

Aベストアンサー

こんにちは。

>そのあと"buf = .ReadText(-2)"で止まり
>"パラメーターが間違っています"と表示されてしまいます。。。
>アドバイスどうぞよろしくお願いします。

ご指摘の部分は、残念ですが、想定外の問題で、ADODBを使って別のやり方はありますが、そのデータ自体の問題であり、原因は分からないままにコードを変えて何度も繰り返す可能性のほうが高いです。別のファイルでも、2番めに同じように起こりますか?

   Next j
  Loop
  .Close
 End With
 Set Strm = Nothing '←は入れたらどうでしょうか。
End Sub '←ここが最後の行

それと、私は、参照設定で、Adodb を入れていること。(Microsoft ActiveX Data Objects 2.8 Library)
Dim Strm As ADODB.Stream

これらは、あまり関係ないけれども、実際に自分がする時はこうします。もちろん、ご質問者さんが選んだ方法を完動するように書き上げただけですから、この延長上に、同様のエラーがなくなるという可能性は低いのではないかと思います。

今、思いついたのは、Excel 関数のClean 関数を間に入れる方法はあるとは思います。
それは、エラーを起こすと予想されるバイナリコードを除去する働きがあります。ただし、エラーがバイナリコードであれば、という条件です。

しかし、こちら側では、根本的な解決策は見当たりません。が、何度もトライするよりも、ダメだったファイルが、どうしてだめだったか、エディターなどで調べていただいたほうが良いですね。そちらのほうが早いのです。
巨大なファイルではない限りは、文字変換で、UTF-8 から、SJISに変換するツールで、一旦変更してから、インポートするほうが楽だと思います。Vector で、Unix系のツールなどいくつかあるようです。

こんにちは。

>そのあと"buf = .ReadText(-2)"で止まり
>"パラメーターが間違っています"と表示されてしまいます。。。
>アドバイスどうぞよろしくお願いします。

ご指摘の部分は、残念ですが、想定外の問題で、ADODBを使って別のやり方はありますが、そのデータ自体の問題であり、原因は分からないままにコードを変えて何度も繰り返す可能性のほうが高いです。別のファイルでも、2番めに同じように起こりますか?

   Next j
  Loop
  .Close
 End With
 Set Strm = Nothing '←は入れたらどうでし...続きを読む

Qマクロ無しで時間自動で記入をしていきたい

すごく贅沢な話なのですが・・・
マクロを使わず、通常のエクセルで時間を手入力でなく何かしらしたら(例:「1」と入力)自動で別セルに現在時刻ほ記載してくれる

マクロだと下記のような内容でやってます(一部)
Range("H3:K33").Select
Selection.Copy
Sheets("結果").Select
Range("A4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

マクロを使わずやれる方法はないでしょうか・・・

Aベストアンサー

論より 証拠、

作ってみました。


式、
=TEXT(IF(ISBLANK(B1),IF(ISBLANK(A10),B10,TODAY()),"此処が 変わります。"),"rr/mm/dd hh:mm")

ファイル、
https://1drv.ms/x/s!AjviygfJDgV_3GnS4Ko-q3mWU9fP

尚、
ファイルは 1度、
ローカルに 別名保存して、
其の保存ファイルを 扱うように、
してくださいね、

別名保存でないと、
意味が 無いですよ。


さすれば、
閲覧も、編集も、
叶うものと 思いますよ。

Qエクセルの時間入力について質問です。 出勤簿を作っています。時間を入力するセルを25時間以上になる場

エクセルの時間入力について質問です。
出勤簿を作っています。時間を入力するセルを25時間以上になる場合を想定してユーザー定義の「[h]:mm」とすれば良いと調べてやってみたのですができません。

8:00→19200:00
17:00→40800:00

すべて24時間を掛け算してる感じになります。なので他にも設定する場所があるのでしょうか?調べても出てこないのでわかる方教えてください。初心者です。よろしくお願いいたします。

Aベストアンサー

そりゃ、8時間を800日と入力すればそうなるに決まっている。
”800”と入力しているでしょ?

”800”と入力して”8:00”と表示するようになっているなら、そのセルの表示形式を確認してください。
恐らく
 0":"00
となっているはずです。
これは「800」と言う数字を百の位で分けて表示しているだけで「時間」ではありません。

そもそもこのようになっていれば「25時」なら ”2500” と入力するだけで「25:00」と表示されますよ。

QエクセルのSUMが合わなくて困ってます! A1~B30にそれぞれ数値があります。 A1~A30の合計

エクセルのSUMが合わなくて困ってます!
A1~B30にそれぞれ数値があります。
A1~A30の合計は電卓なら合計100なのに表示は90。(A31にSUM (A1:A30))
B1~B30の合計は電卓なら合計100なのに表示は110。(B31にSUM (B1:B30))

すみません、これだけの説明で何かわかりますか??

Aベストアンサー

A1~A30をドラッグで選択すると、右下の枠外に合計値が表示されます。
90なら、あなたの計算が間違えてます。

100なら、循環参照等をしていませんか?
セルをコピーして、数値で張り付けしてみて、同じ計算をしてみてください。

QExcelでフィルターを使わずに抽出するにはどうしたらよいのでしょうか

お世話になります。
画像のようにしたいです。
よろしくお願いいたします。

Aベストアンサー

こんな感じでしょうか(Excelっぽくないけど)。
ちなみに、最初の画像のレイアウトを想定して作っています。列の間隔はご自分で調整してください。

Sub sample()
Dim i As Long
Dim c As Long
Dim r As Long
c = 4
r = 2
For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
Cells(r, c).Value = Cells(i, "A").Value
Cells(r, c + 1).Value = Cells(i, "B").Value
If Cells(i, "A").Value = Cells(i + 1, "A").Value Then
r = r + 1
Else
c = c + 2
r = 2
End If
Next i
End Sub

こんな感じでしょうか(Excelっぽくないけど)。
ちなみに、最初の画像のレイアウトを想定して作っています。列の間隔はご自分で調整してください。

Sub sample()
Dim i As Long
Dim c As Long
Dim r As Long
c = 4
r = 2
For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
Cells(r, c).Value = Cells(i, "A").Value
Cells(r, c + 1).Value = Cells(i, "B").Value
If Cells(i, "A").Value = Cells(i + 1, "A").Value Then
r = r + 1
Else...続きを読む

Q保存先フォルダとファイル名について

いつもお世話になっております。
保存をかける際にダイアログボックスを出したく、
またシートA1には保存先、B1にはファイル名を指定しておきたいのですが
どのようにすればよろしいでしょうか?
色々調べたのですが解決できず、アドレスどうぞよろしくお願いします。

ちなみにEXCEL2013を使用しています。

Sub CsvExportWithQuotation()
 Dim FileName As Variant
 Dim Rng As Range
 Dim LastCell As Range
 Dim c As Range
 Dim i As Long
 Dim strLine As String, fname As String, fpath As String

fpath = cells(1,1).value
fname = cells(1,2).value
 FileName = Application.GetSaveAsFilename( fpath & "¥" & fname,fileFilter:="CSVt Files (*.csv), *.csv")

保存先は指定出来るのですが、ファイル名が表示されません。
何卒よろしくお願い致します。

いつもお世話になっております。
保存をかける際にダイアログボックスを出したく、
またシートA1には保存先、B1にはファイル名を指定しておきたいのですが
どのようにすればよろしいでしょうか?
色々調べたのですが解決できず、アドレスどうぞよろしくお願いします。

ちなみにEXCEL2013を使用しています。

Sub CsvExportWithQuotation()
 Dim FileName As Variant
 Dim Rng As Range
 Dim LastCell As Range
 Dim c As Range
 Dim i As Long
 Dim strLine As String, fname As String, fp...続きを読む

Aベストアンサー

No1です。

>セルではなく直接書いてみたのですが
>ファイル名はFALSE.csv と表示がされました。
ご提示の通りの式を与えれば、そうなります。

第一引数をファイル名と解釈して評価しようとしますので、
> InitialFilename = "保存先&ファイル名"
 1)まず式をそのまま評価すると False(論理値)となり
 2)要求されているのは文字列なので、変換した"FALSE"を値として採用
 3)拡張子「.csv」が付け加えられて
 4)ダイアログのファイル名欄に「FALSE.csv」と表示
という処理がなされているものと思います。

>セルに関数も入っていないのに謎です
セルの値を参照していないのであれば、セルの状態がどうであるかは関係ないはずです。
(関係したら、その方がおかしい)

Qエクセル 2016 VBA マクロ 別シートとの照合

Sheet2のA列、E列、G列、H列、I列、K列、M列と
Sheet1のA列、D列、F列、G列、H列、J列、L列を照合して
Sheet2のN列に"削除"と記載があればSheet1の該当行を削除
Sheet2のN列に"削除"以外の記載があれば
Sheet1のM列にSheet2のN列に記載されている文字を反映。

1行目はタイトル行。
最終行は共にA列で判断します。

以上のマクロを教えてください。
宜しくお願い致します。

Aベストアンサー

何度もごめんなさい。

まったく別の方法でやってみました。
配列を使わない方法なので少し時間を要するかもしれませんが、Sheet1が400行程度だというコトなので
そんなに手待ちになるコトはないと思います。

オーソドックスなやり方で、作業用の列を使ってみました。

Sub Sample3()
 Dim i As Long, j As Long
 Dim lastRow As Long, c As Range
 Dim myStr As String, wS As Worksheet, myAry
  Set wS = Worksheets("Sheet2")
   wS.Range("P:P").Insert
    myAry = Array(1, 5, 7, 8, 9, 11, 13)
     For i = 2 To wS.Cells(Rows.Count, "A").End(xlUp).Row
      With wS.Cells(i, "P")
       For j = 0 To UBound(myAry)
        .Value = .Value & wS.Cells(i, myAry(j)) & "_"
       Next j
      End With
     Next i
    With Worksheets("Sheet1")
     myAry = Array(1, 4, 6, 7, 8, 10, 12)
     lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
      For i = 2 To lastRow
       For j = 0 To UBound(myAry)
        myStr = myStr & .Cells(i, myAry(j)) & "_"
       Next j
       Set c = wS.Range("P:P").Find(what:=myStr, LookIn:=xlValues, lookat:=xlWhole)
        If Not c Is Nothing Then
         .Cells(i, "M") = wS.Cells(c.Row, "N")
        End If
       myStr = ""
      Next i
     .Rows(1).AutoFilter field:=13, Criteria1:="削除"
      If .Cells(Rows.Count, "A").End(xlUp).Row > 1 Then
       Range(.Cells(2, "A"), .Cells(lastRow, "M")).SpecialCells(xlCellTypeVisible).Delete shift:=xlUp
      End If
     .AutoFilterMode = False
    End With
     wS.Range("P:P").Delete
     MsgBox "完了"
End Sub

※ コードの最初と最後に
>Application.ScreenUpdating = False

> Application.ScreenUpdating = True
を付け加えると少しは時間短縮ができるかも・・・m(_ _)m

何度もごめんなさい。

まったく別の方法でやってみました。
配列を使わない方法なので少し時間を要するかもしれませんが、Sheet1が400行程度だというコトなので
そんなに手待ちになるコトはないと思います。

オーソドックスなやり方で、作業用の列を使ってみました。

Sub Sample3()
 Dim i As Long, j As Long
 Dim lastRow As Long, c As Range
 Dim myStr As String, wS As Worksheet, myAry
  Set wS = Worksheets("Sheet2")
   wS.Range("P:P").Insert
    myAry = Array(1, 5, 7, 8, 9, 11, 1...続きを読む

Qエクセルの一覧からカードを作成したい

同様の質問を見つけてはいるのですが、なかなか理解できず…
教えていただきたいです。
まずはじめに、このエクセルは前任者が作成しており、
どのような計算式を使っているのかも不明、という状況です。

エクセルのシート1(data)に一覧が入るようになっています。
A列=日付、B=名称、C=部署…N列まであります。
※別シートのボタンを押して、別で用意してあるCSVファイルを選択する
とデータが入るようになっています。

エクセルシート2にカードが作成されます。
※計算式が入っていたので、表示させた画像を添付しました。

現在は12枚のカードが作成されるようになっていて、このサイズでA4に収まります。
これを90人分作成の依頼があり、行をコピーしても、列をコピーしてもうまく反映されません。
一つずつ計算式の参照を変更するには時間がかかってしまいます。

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

Aベストアンサー

こんにちは

まったく、No1様のおっしゃる通りですね。


とは言え、もう引き下がれないのなら、知恵を使ってできる範囲で対応するのも社会人の資質だとも思いますけれど・・・

>これを90人分作成の依頼があり
目的は、一覧リストからある形式に変換されたラベル状のものを90人分作成するということですよね。
しかも、最初の12人分はすでに作成できる状態であるってことでしょ?
(仕組みとしてセル参照の関数になっていることまでわかっている)
『90人分に対応できる仕組みを作る』という依頼ではないのですよね?

ならば簡単。
まず現状の表示を別シートに1ページの内容を「コピー」→「値をペースト」で保管
一覧データの13~24人目を1~12のセルへコピペ
対応するラベルができるので、これをコピー → 先ほどの下方に、値のペースト

上記を8回繰り返せば終わるので、悩んでいる間の、ものの10分もあれば足りると思いますが。


>行をコピーしても、列をコピーしてもうまく反映されません。
関数をコピーしてうまく参照関係を移動する方法の一つとして、セルの位置(行や列)から計算して、OFFSETやINDEX<、INDIRECT関数などを利用して目的の参照にするものがあります。
今後とも表計算ソフトを利用なさるのなら、お時間のある時に覚えておいても損はないかも知れません。

あるいは、VBAを覚えておくといろいろなことができるようにはなりますが、若干ハードルが上がるのと、向き不向きがあるので誰でもというわけにはいかないです。

こんにちは

まったく、No1様のおっしゃる通りですね。


とは言え、もう引き下がれないのなら、知恵を使ってできる範囲で対応するのも社会人の資質だとも思いますけれど・・・

>これを90人分作成の依頼があり
目的は、一覧リストからある形式に変換されたラベル状のものを90人分作成するということですよね。
しかも、最初の12人分はすでに作成できる状態であるってことでしょ?
(仕組みとしてセル参照の関数になっていることまでわかっている)
『90人分に対応できる仕組みを作る』という依頼ではないのです...続きを読む


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

人気Q&Aランキング