![](http://oshiete.xgoo.jp/images/v2/pc/qa/question_title.png?5a7ff87)
以下のマクロを作りました。Webクエリで、セルA1に入力してあるURLを読み込んで表を取り込み、必要なところを選択してコピーするようにしたいのです。しかし、実行すると上から3行目まで黄色になってエラーになります。特に3行目には矢印が表示されています。いろいろ調べましたが結局分かりませんでした。宜しくお願いします。
------------------------------------------------------
Sub クエリで取得()
'
' クエリで取得 Macro
' マクロ記録日 : 2009/7/30 ユーザー名 : charlie
'
'
With ActiveSheet.QueryTables.Add(Connection:= _
Range("A1").Value _
, Destination:=Range("A2"))
.Name = "resultlist?tbws=x0p01a&hd=20090716&jcd=01_2"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = False
.RefreshOnFileOpen = False
.BackgroundQuery = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = True
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Range("A19:Q54").Select
Selection.Copy
End Sub
----------------------------------------------------------
No.2ベストアンサー
- 回答日時:
下記で試してみて。
URL の簡易チェックで Like 演算子を使うため、大小文字の統一の
必要があり、Lcase 関数で URL を小文字化してたのが原因かも。
Sub クエリで取得()
Dim sConnectionStr As String
Dim sh As Worksheet
Set sh = Worksheets("クエリで取得")
sConnectionStr = Trim$(sh.Range("A1").Text)
If Len(sConnectionStr) = 0 Then Exit Sub
If LCase$(sConnectionStr) Like "http://*" Or _
LCase$(sConnectionStr) Like "https://*" Then
sh.Rows("2:" & CStr(sh.Rows.Count)).ClearContents
sConnectionStr = "URL;" & sConnectionStr
With sh.QueryTables.Add(Connection:=sConnectionStr, _
Destination:=sh.Range("A2"))
.FillAdjacentFormulas = False
.PreserveFormatting = False
.RefreshStyle = xlOverwriteCells
.AdjustColumnWidth = False
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = True
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
.Delete
End With
sh.Range("A19:Q54").Copy
Else
MsgBox "A1 セルが未入力か URL として不適切", vbInformation
End If
End Sub
いやっ!できました!!!
感動です。イメージ通りのものができました。
感謝!感謝!感謝!です。
いろいろご親切にこちらのわがままを聞いて頂いて恐縮です。ありがとうございました。
いつも、『新しいマクロの記録』から作成して、不要な部分を削除する方法で作っていました。今回変数をはじめて知りました。いろいろなことができそうですね。難しそうですが、勉強してみます。
ありがとうございましたm(__)m
No.1
- 回答日時:
QueryTables.Add(Connection:=~ に URL を指定する場合、URL であることを
表す "URL;" というキーワードが必要(下記ソースの※のライン)です。
また、不要と思われる各種プロパティー設定は多少整理しました。
下記ソースを VBE にコピー&ペーストすると http:// の部分で余計な「?」
記号までペーストされますが、削除して下さい。
Sub クエリで取得()
Dim sConnectionStr As String
Dim sh As Worksheet
' WEB クエリを作成するシートを参照
Set sh = ActiveSheet ' または Worksheets("シート名")
' 前処理:余計なホワイトスペース等を除去し、Like 演算子で比較
' できるように小文字化しておく
sConnectionStr = Trim$(LCase$(sh.Range("A1").Text))
' A1 にはデータが入力されていて、かつ http:// で始まっているか
If Len(sConnectionStr) And sConnectionStr Like "http://*" Then
' 前処理:一応シートをクリアした方が良いでしょう
sh.Rows("2:" & CStr(sh.Rows.Count)).ClearContents
' ※POINT: 接続文字列に URL であることを表すキーワードを付与
sConnectionStr = "URL;" & sConnectionStr
' WEB クエリを作成する
With sh.QueryTables.Add(Connection:=sConnectionStr, _
Destination:=sh.Range("A2"))
.FillAdjacentFormulas = False
.PreserveFormatting = False
.RefreshStyle = xlOverwriteCells
.AdjustColumnWidth = False
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = True
.WebDisableRedirections = False
' 実際にインポートするには Refresh メソッドを実行する
' 今回はインポートが完了するまで待機する必要があるので、
' BackgroundQuery は False にしておく
.Refresh BackgroundQuery:=False
' WEB クエリを繰り返し更新する必要がなければ
' 削除した方が省リソースです
.Delete
End With
sh.Range("A19:Q54").Copy
Else
MsgBox "A1 セルが未入力か URL として不適切", vbInformation
End If
End Sub
この回答への補足
Sub クエリで取得()
'
' クエリで取得 Macro
' マクロ記録日 : 2009/8/1 ユーザー名 : charlie
'
Dim sConnectionStr As String
Dim sh As Worksheet
Set sh = Worksheets("クエリで取得")
sConnectionStr = Trim$(LCase$(sh.Range("A1").Text))
If Len(sConnectionStr) And sConnectionStr Like "https://*" Then
sh.Rows("2:" & CStr(sh.Rows.Count)).ClearContents
sConnectionStr = "URL;" & sConnectionStr
With sh.QueryTables.Add(Connection:=sConnectionStr, _
Destination:=sh.Range("A2"))
.FillAdjacentFormulas = False
.PreserveFormatting = False
.RefreshStyle = xlOverwriteCells
.AdjustColumnWidth = False
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = True
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
.Delete
End With
sh.Range("A19:Q54").Copy
Else
MsgBox "A1 セルが未入力か URL として不適切", vbInformation
End If
End Sub
-------------------
上記のように修正しましたが、
.Refresh BackgroundQuery:=Falseで黄色のエラーになります。
どうしたらよいでしょうか。
尚、http://をhttps://にしました。
宜しくお願いします。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) マクロを短くする 1 2023/01/15 00:11
- Visual Basic(VBA) [Excel VBA] このコードでは行の挿入や行の消去をすると13のエラーが出てしまう。 3 2022/12/09 00:29
- Visual Basic(VBA) マクロで最終行を取得してコピーしたい 3 2022/04/06 19:07
- Visual Basic(VBA) 【VBA】写真の貼り付けコードがうまく機能しません。 5 2022/09/01 18:43
- Visual Basic(VBA) エクセルのマクロを使ってメールを送る方法について教えてください 2 2022/03/29 01:36
- Visual Basic(VBA) Excelのマクロコードについて教えてください。 1 2022/03/27 13:25
- Visual Basic(VBA) vbaでセルに入力したときに,その横にあるセルを保護し入力不可にするマクロを作りたいです。 2 2022/04/24 20:59
- Visual Basic(VBA) 動きっぱなしです。止め方とプロシージャの間違いを教えて下さい! 5 2022/08/15 23:08
- Visual Basic(VBA) エクセル VBA 処理スピードを上げたいのですが。 6 2023/03/31 20:52
- Excel(エクセル) Excelでnullになるような式のセルをマクロで空白行と認識させるにはどうすればいいですか? 3 2023/03/13 13:42
関連するカテゴリからQ&Aを探す
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Excel VBA インデックスの境...
-
エクセルVBAで SendKeys "{TAB}"
-
VBA 最終行取得からの繰り返し貼付
-
Excel で行を指定回数だけコピ...
-
AQUOS 602SH
-
Excelでデータの抽出&別シート...
-
【エクセル】 連続印刷する際の...
-
SHの7シリーズ
-
別シートの一定範囲を、コピー...
-
シャープのアクオス sh-m25 を...
-
excelの差込印刷で可視セルだけ...
-
マクロを簡潔にしたいので教え...
-
EXCELマクロで全シート対...
-
スマホ機種変更で旧機種のGoogl...
-
FOMAカード(UIM)異常
-
HDを修理できるメーカー教え...
-
PC修理の値段と技術について
-
外付けHDのアダプタ間違え、起...
-
PCの修理
-
822SH 音楽データ転送のやり方...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Excel で行を指定回数だけコピ...
-
excelの差込印刷で可視セルだけ...
-
Excel VBA インデックスの境...
-
VBA:同じ文字列データの比...
-
エクセルVBA 別シートの複数の...
-
エクセル:VBAで月変わりで、自...
-
エクセルVBAで SendKeys "{TAB}"
-
VBA別シートの最終行の下行へ貼...
-
エクセルVBAで 2種のリストを...
-
歯抜けの時間を埋めて行の挿入
-
Excel VBAでシート内全体に非表...
-
VBAで複数シート選択
-
EXCELマクロで全シート対...
-
Excel VBA :2回目以降実行で貼...
-
VBAで条件が一致する行のデータ...
-
VBAの指示の内容 昨日こちらで...
-
【WORD差し込み印刷】複数レコ...
-
エクセル シート保護後コメン...
-
Excelでデータの抽出&別シート...
-
エクセルVBAで実行時エラー...
おすすめ情報