ママのスキンケアのお悩みにおすすめアイテム

取り込むWeb上の表が1画面のみの場合は簡単なのですが、”次の10件”や”次のページ”よいった格好で、取り込みたい表(データ)が複数のページに及ぶ場合、そのデータをマクロ等で自動的に取り込むためにはどうしたらよいのですか?全部で1000件あるデータを取り込む場合、とても手作業で100回(1000件÷10件)も繰り返すのは現実的ではないため。

このQ&Aに関連する最新のQ&A

A 回答 (3件)

基本的には、ページ数を何らかの方法で取得して、URLを


固定部分+変数で指定してループさうるだけです。

↓はYahoo電話帳をウェブクエリで取得するサンプルです。
ただ、ちょいと不安定です。
>.Refresh BackgroundQuery:=False
でエラーになる可能性があります。

WEBクエリを使わずにWEBソースから内容を取得する方法も
ありますが、全てのHPで使えるわけではありません。

Option Explicit

Public myie As Object
Public kai1 As Integer
Public kai2 As Integer

Sub denwatyou()
Dim s As String
Dim kai As Integer
Dim i As Long
Dim j As Integer
Dim k As Integer
Dim cnt As Long
Dim myrng As Range
Dim myurl As String
Dim motourl As String
motourl = "http://phonebook.yahoo.co.jp/list?a2=46201&g3=44 …
Set myie = CreateObject("InternetExplorer.Application")
With myie
.navigate motourl
.Visible = True
While .Busy Or .readyState <> 4
Wend
Call numget
kai = kai2 \ kai1 + 1
For k = 1 To kai
Set myrng = Worksheets(1).Cells(65536, 1).End(xlUp).Offset(1)
'myurl = motourl & motourl & "&b=" & k & "&h=s"
'-----
If Right(motourl, 1) = "/" Then
myURL = motourl & "?b=" & k & "&h=s"
Else
myURL = motourl & "&b=" & k & "&h=s"
End If
'------
myie.navigate myurl
While myie.Busy Or myie.readyState <> 4
Wend
With ActiveSheet.QueryTables.Add(Connection:="URL;" & myurl, Destination:=myrng)
.Name = Split(motourl, "/")(3)
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "11"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Next k
End With
End Sub

Sub numget()
Dim Mybody As String
Dim s As Variant
Dim linestr As String
Dim i As Long
Dim cnt As Long
Dim MyDoc As Object 'MSHTML.HTMLDocument
Set MyDoc = myie.document
Mybody = MyDoc.body.innerHTML
s = Split(Mybody, vbCrLf)
cnt = UBound(s)
For i = 0 To cnt
linestr = s(i)
If linestr Like "*</B>件中<B>*" Then
kai2 = Split(Split(linestr, "<B>")(1), "</B>")(0)
kai1 = Split(Split(Split(linestr, "<B>")(2), "</B>")(0), "~")(1)
Exit For
End If
Next i
'myie.Quit
End Sub
    • good
    • 0
この回答へのお礼

回答ありがとうございます。
ただ、​http://phonebook.yahoo.co.jp/list?a2=46201&g3=44 …
にアクセスしたら
「指定されたURLは見つかりませんでした。」が出てきて、せっかくの回答内容を検証できません。

お礼日時:2009/01/23 10:48

URLの不具合については、ちょうど別サイトでも話題になってました。


あえてURLはリンクしませんが、

「WEBからコピー時の特殊文字(?)の削除」

で検索したら見つかると思います。
まだ進行中の話題です。

URLをWEBからコピペするのでしたら参考になると思います。

また、IEで現在表示しているページのURLを取得するなら
こんなかんじいけます。
タイトルの取得も入れてあります。

Dim MyShell As Object, MyWindow As Object
Dim myurl As String
Dim mytitle As String
Set MyShell = CreateObject("Shell.Application")
For Each MyWindow In MyShell.Windows
If UCase(Right(MyWindow.FullName, 12)) = "IEXPLORE.EXE" Then
myurl = MyWindow.Locationurl
mytitle = MyWindow.document.Title
MsgBox myurl & vbCrLf & mytitle

End If
Next
Set MyShell = Nothing
    • good
    • 0

WebからコピーしてそのままVBEに貼り付けてませんか?


そうするとURLの部分がおかしくなります。

テキストエディタにコードを貼り付けてみると、URLの部分
の前後に長さ0の文字列が挿入されているようです。
URLの部分を修正して実行してみてください。

※私のコードをVBEに貼り付けると、URLの部分が赤くなっているはずです。
この状態のときはおかしいと思ってください。

この回答への補足

たびたび申し訳ありません。
For i = 0 To cnt
linestr = s(i)
If linestr Like "*</B>件中<B>*" Then
kai2 = Split(Split(linestr, "<B>")(1), "</B>")(0)
kai1 = Split(Split(Split(linestr, "<B>")(2), "</B>")(0), "~")(1)
Exit For
End If
Next i
が全く理解できません。いくら検索しても、似たようなものにヒットしないため、さっぱりわかりません。"*</B>件中<B>*は一体何なのでしょうか?

補足日時:2009/01/27 15:23
    • good
    • 0
この回答へのお礼

ありがとうございます。
上手く動きますね。
大変助かりました。
出力された表を見映えよく整えるくらいは自分でVBできますので、これからやります。

お礼日時:2009/01/27 09:18

このQ&Aに関連する人気のQ&A

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

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

このQ&Aを見た人が検索しているワード

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

QVBA webクエリをループさせる方法が知りたい

Excel VBAを使用してwebクエリをループさせる方法が知りたいです。

例えば、以下のように複数のURLがあったとします。
Sheet1のB2セル~B3、B4、B5・・・

━━【B】━━━━
【1】
【2】http://dailynews.yahoo.co.jp/fc/
【3】http://shopping.yahoo.co.jp/
【4】http://www.yahoo.co.jp/
【5】http://chiebukuro.yahoo.co.jp/
【6】http://dic.yahoo.co.jp/



━━━━━
上記すべてのwebページの内容をコマンドボタンワンプッシュでSheet2のA1セルから下へ順に反映させたいといった感じです。

当方VBA初心者ですので、できるだけわかりやすくご教授頂けると助かります。
よろしくお願いいたします。

Aベストアンサー

>Excel VBAを使用してwebクエリをループさせる方法が知りたいです。
 「webクエリ」ですよね?
 Excel の 標準メニュー [データ(D)] - [外部データの取り込み(D)] - [新しい Web クエリ(W)...] のお話しとして回答を書かせていただきます。

【作業の段取り】
1)先ず、データ を取り込む「Sheet2のA1セル」を アクティブ にします。
2)次に「Sheet1のB2セル~B3、B4、B5・・・」の URL を1つずつ読み込んで、WEb クエリ を実行します。
3)1つの URL の データ を読み込んだ後には、その クエリ デーブル の最終行の次行を アクティブ にします。

【VBA の コード を書く場所について】
 「コマンドボタン」を右クリック し、[コードの表示(V)] を クリック すると、
Private Sub CommandButton*_Click()
End Sub
というような コード が現われます(「*」の部分は数字)ので、その2行の「間」に
  Sheets("Sheet2").Select
  Application.Run "Sheet2.webクエリをループ"
を コピペ してください。

 次に、Sheet2 の シート タブ を 右クリック し、[コードの表示(V)] を クリック すると現われる コード ウィンドウ に下記を コピペ してください。

Sub webクエリをループ()
  Dim myQT As QueryTable
  Dim i As Long
  Dim myURL As String
  Cells.Delete
  For Each myQT In QueryTables: myQT.Delete: Next
  Range("A1").Select
  For i = 2 To Sheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Row
    myURL = Sheets("Sheet1").Cells(i, "B").Value
    With QueryTables _
        .Add(Connection:="URL;" & myURL, Destination:=Selection)
      .BackgroundQuery = False
      .AdjustColumnWidth = False
      .WebSelectionType = xlEntirePage
      .WebFormatting = xlWebFormattingNone
      .Refresh BackgroundQuery:=False
    End With
    Cells(ActiveCell.Row + QueryTables(1).ResultRange.Rows.Count, 1).Select
  Next
End Sub

【コーディング について】
 先ず、
.BackgroundQuery = False
以下の、QueryTables の プロパティ につきましては、実情に応じて変更なさってください。

 QueryTables の操作は、当該シート を離れると、記述が厄介になりますので、Sheet2 に 実行マクロ を書いて、その マクロ を CommandButton*_Click() で呼び出すようにしました。

【クエリ デーブル の最終行の取得】
 ポイント としては、1つの URL の データ を読み込んだ後の最終行の取得ですが、最後に実行された Web クエリ について QueryTables の インデックス が「1」になるようですので、
QueryTables(1).ResultRange.Rows.Count
が 当該 クエリ テーブル の行数になります。

 従いまして、現在の カーソル 位置(データ の反映位置「Destination」)の行番号に、それを足すと、「クエリ デーブル の最終行の次行」を取得できます。
Cells(ActiveCell.Row + QueryTables(1).ResultRange.Rows.Count, 1).Select

【これは、余談かも知れませんが。。】
 Sheet2 の データ を全部削除しても、QueryTables がそのまま残って、ファイル の容量を大きくしたり、他にも問題が残りそうな気がします。
 これを回避するためには、
  For Each myQT In QueryTables: myQT.Delete: Next
を付加しました。

>Excel VBAを使用してwebクエリをループさせる方法が知りたいです。
 「webクエリ」ですよね?
 Excel の 標準メニュー [データ(D)] - [外部データの取り込み(D)] - [新しい Web クエリ(W)...] のお話しとして回答を書かせていただきます。

【作業の段取り】
1)先ず、データ を取り込む「Sheet2のA1セル」を アクティブ にします。
2)次に「Sheet1のB2セル~B3、B4、B5・・・」の URL を1つずつ読み込んで、WEb クエリ を実行します。
3)1つの URL の データ を読み込んだ後には、その クエリ ...続きを読む

Qエクセル:シート名を手入力でなく、セル「A1」の文字を出したい。

いつもお世話になります。
エクセルのシート名についての質問です。
いつもはシート名を変えるとき、シートタブの上を右クリックして「変更」しています。

◆そこで、
(1) セル「A1」に入力されてある文字を自動で出す
(2) もしくはマクロボタンを押すと「A1」に入力されてあるものが「シート名」として変わる

というようにしたいのですが、その方法について教えてください。よろしくお願いいたします。

Aベストアンサー

こんにちは。


(1)の場合は、下記のコードを ThisWorkbook に記述してください。
どのワークシートでも機能します。

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Address = "$A$1" Then Sh.Name = Target.Range("A1").Value
End Sub


(2)場合は、下記のコードを標準モジュールに記述しボタンにマクロ登録してください。
(すべてのシートにボタンを貼り付けるのは面倒でしょうから、ツールバーにボタンとして追加すると良いと思います。)

Public Sub SheetName()
ActiveSheet.Name = Range("A1").Value
End Sub

Qエクセル 0や空白のセルをグラフに反映させない方法

以下の点でどなたかお教えください。

H18.1~H20.12までの毎月の売上高を表に記載し、その表を元にグラフを作成しています。グラフに反映させる表の範囲はH18.1~H20.12の全てです。
そのためまだ経過していない期間のセルが空白になり、そこがグラフに反映され見づらくなります。
データを入力する都度グラフの範囲を変更すればいいのですが、うまく算式や設定等で空白や0円となっているセルをグラフに反映させない方法はありますか?

お手数ですが、よろしくお願いいたします。

Aベストアンサー

売上高のセルは数式で求められているのですよね?
それなら
=IF(現在の数式=0,NA(),現在の数式)
としてみてください。
つまり、0の場合はN/Aエラーにしてしまうんです。N/Aエラーはグラフに反映されません。

Qエクセル 祝日の関数を教えてください

条件付き設定で土、日、祝日に色を付けたカレンダーを作っています。

曜日の色の付け方はいろいろあるようですが、今回は

土曜日・・・=WEEKDAY($A1)=7
日曜日・・・=WEEKDAY($A1)=1

=WEEKDAY($A1)=の後に、土曜日は「7」、
日曜日は「1」で作りました。

そこで質問ですが、祝日の場合には「=」の後の数字をいくつで設定するのでしょうか?

よろしくお願いします。

Aベストアンサー

Excel(エクセル)実用編:カレンダーの作成例
http://www.eurus.dti.ne.jp/~yoneyama/Excel/jituyou/calendar.htm
・祝日の色を変更します。 

ご参考まで。

QVBAマクロ実行時エラーの修正について

VBA超初心者です。

CSVファイルをインポートし、データ更新すると、下記エラーが起こります。

実行時エラー '-2147021882 (8007000e)'
データの消失を防ぐため、空白でないセルをワークシートの外にシフトすることはできません。
Ctrl+Endキーを押して最後の空白でないセルに移動し、そのセルとデータの末尾との間にある
すべてのセルを削除またはクリアしてください。その後、セルA1を選択し、ブックを保存して最後の
セルをリセットしてください。

(以下にも文章ありますが、一部しか表示されません)

この時、「デバック」ボタンを押すと、以下のマクロ表示となります。

Sub データ更新()

’データ更新日報出力Macro
’マクロ記録日:○○○ ユーザ名:○○


  ScreenUpdating = False
Worksheets("sheet1")Select
Range("A2").Select
Selection.QueryTable.Refresh BackgroundQuery:=False
  Range("A2").Select
End Sub

Sub ピボットテーブル更新日報印刷()
   Sheets("Sheet2").Select
Range("B14").Select
ActiveSheet.PIvotTables("ピボットテーブル1").RefreshTable
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:True
End Sub


この構文で、Selection.QueryTable.Refresh BackgroundQuery:=False が
 間違っているようなのですが、どうすればいいのか良くわかりません。
 どなたか教えていただけないでしょうか?

VBA超初心者です。

CSVファイルをインポートし、データ更新すると、下記エラーが起こります。

実行時エラー '-2147021882 (8007000e)'
データの消失を防ぐため、空白でないセルをワークシートの外にシフトすることはできません。
Ctrl+Endキーを押して最後の空白でないセルに移動し、そのセルとデータの末尾との間にある
すべてのセルを削除またはクリアしてください。その後、セルA1を選択し、ブックを保存して最後の
セルをリセットしてください。

(以下にも文章ありますが、一部しか表示されません)

こ...続きを読む

Aベストアンサー

>Selection.QueryTable.Refresh BackgroundQuery:=False
この『構文』自体が間違っているわけではありません。
"sheet1"のA2セルに設定されているQueryTable(外部データ取り込み)
を更新する時に、エラーが発生して更新できない、という意味です。

おそらく、エラー原因はエラーメッセージそのままではないでしょうか。
『..空白でないセルをワークシートの外にシフトすることはできません..』

QueryTableの設定によっては、取り込みデータを挿入するようになっています。
例えば、シートの最下行にデータがあって、
取り込みデータを挿入するとデータがはみ出てしまう、という場合は
そういったエラーメッセージが出る事も考えられます。
#こちらの環境では再現できなかったので半分自信なしですが -"-

対策もエラーメッセージに書かれている通りです。
例えば"sheet1"で使用中のデータの最終行が1,000行だと思っていても、
それ以下になんらかの使用領域が残っている可能性があります。
Ctrl+Endキーを押してみてください。
"sheet1"の実際の最終セルに移動します。
その行から1,001行目までを選択して削除してください。
(実際に必要なデータがないかどうかを確認の上で。)
その後ブックを保存してください。

以上で解消すれば良いのですが。

または、QueryTableの設定を変更してみる方法もあります。
"sheet1"のA2セルを選択して右クリック。
[データ範囲のプロパティ]を開きます。
『変更されたレコード(行)のデータ更新時の処理:』

○新しいデータのセルを挿入し、使用されていないセルを削除する
になっていたら、
○既存のセルを新規データで上書きし、使用されていないセルはクリアする
に変更してみてください。

いずれかでも解消できない場合は
現在のシート状態と実際の利用の仕方などの詳細情報があると
他にアドバイスあるかもしれません。
(例えば外部データを取り込んだ後に数式や書式を設定していたりとか、
 何かの図形を配置しているとか)

>Selection.QueryTable.Refresh BackgroundQuery:=False
この『構文』自体が間違っているわけではありません。
"sheet1"のA2セルに設定されているQueryTable(外部データ取り込み)
を更新する時に、エラーが発生して更新できない、という意味です。

おそらく、エラー原因はエラーメッセージそのままではないでしょうか。
『..空白でないセルをワークシートの外にシフトすることはできません..』

QueryTableの設定によっては、取り込みデータを挿入するようになっています。
例えば、シートの最下行にデータがあ...続きを読む

Q【Excel】列と行の最後尾にジャンプする方法は?

Excel2007です。

タスク操作でも、ショートカットでもよいのですが、質問のように
列と行、それぞれの終わりにジャンプできる方法を教えてください。

Aベストアンサー

放置で終わるのかと思っていたら補足が付きましたね。

シート自体の一番下、右と言うことですか。

でしたら、Ctrl+↓、Ctrl+→を何回か繰り返せば行きますよ。
大抵は1回目で入力範囲の最後、もう1回で端までいくはずです。
間に未入力セルと入力セルが挟まる場合はその都度移動が止まりますので繰り返してください。
やってみればわかります。

あとは、最終セルのアドレスを名前ボックスに入力とかですかね。

私の書いた下辺、右辺はセルを四角とした時の下や右の線です。
マウスのポインタを線の上に持って行くと上下左右に外向きの矢印にポインタが変わりますのでそこでダブルクリックします。
但しこれは入力範囲で移動の時の方法です。

QExcel VBAでのwebクエリ取得データの表示

Excel VBAを使用してwebクエリでSheet1のB2セル~B3、B4、B5・・・と複数のURLからデータをループで取得し、Sheet2のA1セル~A2、A3、A4にて表示しています。
取得データの内容が3行だと仮定(あくまで仮定です)すると、通常であれば以下※1のように表示されると思います。

※1
━━【A】━━━━
【1】B2セルURLの取得内容
【2】B2セルURLの取得内容
【3】B2セルURLの取得内容
【4】B3セルURLの取得内容
【5】B3セルURLの取得内容
【6】B3セルURLの取得内容
【7】B4セルURLの取得内容
【8】B4セルURLの取得内容
【9】B4セルURLの取得内容
・      ・
・      ・
・      ・
━━━━━

これを以下※2のように、取得したデータを横に表示することはできないでしょうか?

※2
━━【A】━━━━━━━━【B】━━━━━━━━【C】━━━━
【1】B2セルURLの取得内容 B2セルURLの取得内容 B2セルURLの取得内容
【2】B3セルURLの取得内容 B3セルURLの取得内容 B3セルURLの取得内容
【3】B4セルURLの取得内容 B4セルURLの取得内容 B4セルURLの取得内容
【4】B5セルURLの取得内容 B5セルURLの取得内容 B5セルURLの取得内容
【5】B6セルURLの取得内容 B6セルURLの取得内容 B6セルURLの取得内容
・      ・          ・          ・
・      ・          ・          ・
・      ・          ・          ・
━━━━━

参考までに以下VBAを使用して、webクエリをループでデータ取得しています。

━━━━━
Sub webクエリ()
  Dim myQT As QueryTable
  Dim i As Long
  Dim myURL As String
  Cells.Delete
  For Each myQT In QueryTables: myQT.Delete: Next
  Range("A1").Select
  For i = 2 To Sheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Row
    myURL = Sheets("Sheet1").Cells(i, "B").Value
    With QueryTables _
        .Add(Connection:="URL;" & myURL, Destination:=Selection)
      .BackgroundQuery = False
      .AdjustColumnWidth = False
      .WebSelectionType = xlEntirePage
      .WebFormatting = xlWebFormattingNone
      .WebTables = "2"
      .Refresh BackgroundQuery:=False
    End With
    Cells(ActiveCell.Row + QueryTables(1).ResultRange.Rows.Count, 1).Select
  Next
End Sub
━━━━━

当方VBA初心者ですので、できるだけわかりやすくご教授頂けると助かります。
よろしくお願いいたします。

Excel VBAを使用してwebクエリでSheet1のB2セル~B3、B4、B5・・・と複数のURLからデータをループで取得し、Sheet2のA1セル~A2、A3、A4にて表示しています。
取得データの内容が3行だと仮定(あくまで仮定です)すると、通常であれば以下※1のように表示されると思います。

※1
━━【A】━━━━
【1】B2セルURLの取得内容
【2】B2セルURLの取得内容
【3】B2セルURLの取得内容
【4】B3セルURLの取得内容
【5】B3セルURLの取得内容
【6】B3セルURLの取得内容
【7】B4セルURLの取得内容
【8】B4セルURLの取得内容
【9】B4...続きを読む

Aベストアンサー

NO2のjcctairaです。
> ただ、取得データの1行目しか表示されません。
とのことですが、エラーになるので下記のように修正してテストしています。
URLの内容により違うのかも知れませんが、私のテストではうまくいっているようですが?

Sub webクエリ()
  Dim myQT As QueryTable
  Dim i As Long
  Dim myURL As String
  Cells.Delete
  For Each myQT In ActiveSheet.QueryTables: myQT.Delete: Next
  Range("A1").Select
  For i = 2 To Sheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Row
    myURL = Sheets("Sheet1").Cells(i, "B").Value
    With ActiveSheet.QueryTables _
        .Add(Connection:="URL;" & myURL, Destination:=Selection)
      .BackgroundQuery = False
      .AdjustColumnWidth = False
      .WebSelectionType = xlEntirePage
      .WebFormatting = xlWebFormattingNone
''     .WebTables = "2" ' エラーになるのでコメントアウト
      .Refresh
    End With
    Cells(ActiveCell.Row, "B") = Cells(ActiveCell.Row + 1, "A")
    Cells(ActiveCell.Row, "C") = Cells(ActiveCell.Row + 2, "A")
    Cells(ActiveCell.Row + 1, "A").Select
    Range(ActiveCell.Row & ":" & Rows.Count).Delete
  Next
End Sub

NO2のjcctairaです。
> ただ、取得データの1行目しか表示されません。
とのことですが、エラーになるので下記のように修正してテストしています。
URLの内容により違うのかも知れませんが、私のテストではうまくいっているようですが?

Sub webクエリ()
  Dim myQT As QueryTable
  Dim i As Long
  Dim myURL As String
  Cells.Delete
  For Each myQT In ActiveSheet.QueryTables: myQT.Delete: Next
  Range("A1").Select
  For i = 2 To Sheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).R...続きを読む

QHTML中のTABLEのデータを抽出する方法

あるサイトの <table>タグ中のデータを抽出して、エクセルにコピーし
そのデータを分析したいと考えています。

具体的にはタグ情報を削除して、データをカンマ(,)区切りで表示し、
それをコピペして、エクセルに貼り付ける方法を考えています。

<table>
<tr>
<td>100</td>
<td>200</td>
</tr>
<tr>
<td>300</td>
<td>400</td>
</tr>
</table>



100,200
300,400


上記を実現できる方法をご存知でしたらぜひ教えてください。

いろいろ調べたところ、ブックマークレットという方法で
できそうですが、マッチするものを見つけることができませ
んでした。

Aベストアンサー

firefoxのアドオンに
 ⇒ Dafizilla Table2Clipboard( https://addons.mozilla.jp/firefox/details/1852 )
 ⇒ TableTools2 - Copy/Sort/Chart/Filter Table&More!( https://addons.mozilla.jp/firefox/details/296783 )
があります。お好きに・・
 ブラウザ経由で何かしたいときは、firefoxのアドオンをまず探してみましょう。
Firefox アドオン | Mozilla Japan の公式アドオン紹介サイト( https://addons.mozilla.jp/firefox/ )


人気Q&Aランキング