EXCEL VBA 実行時エラー'1004'が発生する原因と対処方法
- EXCEL VBAを使用して、A列の1~40000行にリンクを設定するコードを実行する際に、65530行までしかリンクが設定できず、以降は実行時エラー'1004'が発生します。
- このエラーは、Excelのバージョンや使用しているデータ型に関係なく発生する可能性があります。
- 解決方法としては、リンクの設定を行う際にループ処理を使用して、65530行ごとにリンクの設定を行うようにするという方法があります。
- ベストアンサー
EXCEL VBA で実行時エラーが出ます。
こんばんは。 エクセルのA列の1～40000行にhttp://www.google.co.jpへのリンクを設定する単純なコードですが、毎回65530行まで行くと「実行時エラー'1004'」が発生します。 （65530はInteger型の倍数に近いかと思いますが、どうなんでしょうか？） 環境はMacのブートキャンプでWindows10Home、Office365の最新版にアップデートしてあります。 よろしくお願いします。 Sub test() Dim i As Long For i = 1 To 80000 ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 1), _ Address:="http://www.google.co.jp", _ TextToDisplay:="■" Next i MsgBox "完了" End Sub 通報する
- kengo0417szk
- お礼率100% (1/1)
- Excel（エクセル）
- 回答数1
- ありがとう数2
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
関連するQ&A
- 【エクセル】VBAでハイパーリンクそうさ
VBAでハイパーリンクのマクロを組んでいます。 A列にホームページ名が50行（シートによってまちまち）くらい並んでいて、 B列に、それに対応するURLが記入されています。B列は空白のところがちらほ らあります。 A列に、A列の表示（ホームぺジ名）のまま、B列のURLでハイパーリンクを張りたい です。リンクは貼れたんですが、ホームページ名がどうやれば表示できるかわかり ません。教えてくださいお願いします。 ダメダメですが、一応自分で書けたところまでを載せておきます。 Sub ハイパーリンク() Dim i As Integer Dim j As Integer j = 50 For i = 1 To j Sheets("Sheet1").Select Cells(i , 1).Select ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _ Cells(i , 2), TextToDisplay:="" Next i End Sub としました。
- ベストアンサー
- オフィス系ソフト
- 実行時エラー'1004'で困っています。
少し前にも同じコードの他の点についてアドバイスをいただいたのですが、新たな問題点が生じたので改めて質問させてほしいです。 具体的な問題点が分からなかったのでコードをそのまま載せました。 シート1に値を入力すると、繁殖牛データ。データ。という２個のシートから検索し、リンクをつけたいです。 繁殖牛データシートに入っている値を入力した時は ActiveSheet.Hyperlinks.Add anchor:=Target, Address:="", SubAddress:="'繁殖牛データ'!" & Range(Cells(kennsaku, 3)) データシートに入っている値を入力した時は ActiveSheet.Hyperlinks.Add anchor:=Target, Address:="", SubAddress:="'" & データ & "'!" & Range(Cells(kennsaku, 1)) で「'Range'メソッドは失敗しました：'_Worksheet'オブジェクト」とでます。 試験的にどちらのシートにも入っていない値を入力すると、思惑通りに"見つからないのでリンクは貼りません"と帰ってきます。 Private Sub Worksheet_Change(ByVal Target As Range) Dim kennsaku, y, z If Target.Count > 1 Then Exit Sub 'セルを二つ以上選択した場合 If Target.Value = "" Then Exit Sub 'データが空の場合 If Application.CountIf(Range("A1:Z80"), Target.Value) > 1 Then MsgBox Target.Value & "は既に入力されています", vbOKOnly + vbExclamation Target.Clear Exit Sub End If Set y = Worksheets("繁殖牛データ").Range("$C$1:$C$1003") Set z = Worksheets("データ").Range("$A$1:$A$65536") kennsaku = Application.Match(Target.Value, y, 0) If IsNumeric(kennsaku) Then ActiveSheet.Hyperlinks.Add anchor:=Target, Address:="", SubAddress:="'繁殖牛データ'!" & Range(Cells(kennsaku, 3)) Else kennsaku = Application.Match(Target.Value, z, 0) If IsError(kennsaku) Then MsgBox "見つからないのでリンクは貼りません", vbOKOnly + vbExclamation Exit Sub Else ActiveSheet.Hyperlinks.Add anchor:=Target, Address:="", SubAddress:="'" & データ & "'!" & Range(Cells(kennsaku, 1)) End If End If Range("A1:Z80").Font.Underline = False End Sub
- ベストアンサー
- オフィス系ソフト
- やはり図形のクリアで実行時エラー1004
図形を二行三列で一枡とし図形を貼り付けていますが、どうしても実行時エラー 「1004」が出て図形のクリアができません。(尚、四角形は枠線上にあります。) 対処法がありましたらお願いします。 Windows7・SP1 Office2010 Sub 図形の貼付け() Dim i As Integer Dim j As Integer For i = 10 To 43 Step 2 For j = 9 To 99 Step 3 Select Case Cells(i, j).Value Case 1: ActiveSheet.Shapes("四角形1").Select Selection.Copy Cells(i + 1, j + 1).Select ActiveSheet.Paste Case 2: ActiveSheet.Shapes("四角形2").Select Selection.Copy Cells(i + 1, j).Select ActiveSheet.Paste Case 4: ActiveSheet.Shapes("四角形3").Select Selection.Copy Cells(i + 1, j + 1).Select ActiveSheet.Paste Case 5: ActiveSheet.Shapes("四角形3").Select Selection.Copy Cells(i + 1, j + 2).Select ActiveSheet.Paste Case 6: ActiveSheet.Shapes("円1").Select Selection.Copy Cells(i, j).Select ActiveSheet.Paste End Select Next Next End Select End Sub Sub 図形のクリア() Dim myRng As Range Set myRng = Range("I10:CW43") Dim n As Integer, sp As Variant For n = ActiveSheet.Shapes.Count To 1 Step -1 Set sp = ActiveSheet.Shapes(n) If Not Intersect(Range(sp.TopLeftCell, sp.BottomRightCell), myRng) Is Nothing (ここで実行時エラー1004になります。) Then sp.Delete End If Next Set myRng = Nothing End Sub
- ベストアンサー
- Visual Basic
- ExcelでのHyperlink
PCのHDに存在するファイルのリストをExcel2010につくりました。 ファイル名に、Hyperlinkを埋め込んで、クリックすることで、当該ファイルを見ることができるようにしたのですが、何故か、６５５３１個のファイルまでしか、HyperLinkを埋め込むことができません。 試しに、先頭の10個のHyperlinkを削除すると、65532番目の行から、10個のhyperlinkを埋め込むことは可能でした。 これは、Excelの制限なのかと思いますが、それならそれで、解除、或は、変更することができるのではないかと考えます。 サジェスチョンをお願い致します。 尚、VBAは、下記のようなものを使っています。 For i = 1 To RowEnd Hyperlinks.Add Anchor:=cells(i,1), Address:=Cells(i, 2).Value & "\" Cells(i, 1).Value, TextToDisplay:=Cells(i, 1).Value Next cells(i,1).value ----- file名 cells(i,2).value ----- path名
- ベストアンサー
- Excel（エクセル）
- VBA【初歩的な質問】
エクセルシートのA列にホームページの名前、B列にそのページのアドレスが入力されております。 A列のページ名にハイパーリンクの情報を結び付けて、B列を削除したいです。 ※A列の名前が青くなっていて、クリックするとそのページに飛んでいくことができて、B列は空白 そのVBAを教えて頂けると助かります。 ページによって最終行が異なるので、最初に最終行を出して、For i で繰り替えしたらいいのでしょうか？ HYPERLINKS.Addメソッドというのを使えばいいと思ったんですが、うまくいきませんでした。 Option Explicit Sub Sample() Dim i As Long '1行目からA列の最終行まで繰り返す For i = 1 To Range("A" & Rows.Count).End(xlUp).Row With ActiveSheet.Hyperlinks .Add Anchor:= End With Next i End Sub
- ベストアンサー
- Visual Basic
- VBAでハイパーリンクをつける
仕事で画像のファイル名をExcelに書き出し、書き出しものにハイパーリンクで見がうまくいきません。下記のものです。どこが悪いのでしょうか？ Option Explicit Dim ドライブ As String Dim フォルダ As String Dim 拡張子 As String Dim 記入シート As String Dim パス As String Dim ファイル名 As String Dim 貼付行 As Integer Sub フォルダ中のファイル名をシートに書く() ドライブ = "C" フォルダ = "分析" 拡張子 = "*." & "JPG" 記入シート = "ファイル一覧" End Sub Private Sub 指定フォルダ中の指定拡張子のファイル名をシートに書く() Sheets(記入シート).Activate Cells.Clear Range("A1").Select パス = ドライブ & ":\" & フォルダ & "\" ファイル名 = Dir(パス & 拡張子) 貼付行 = 0 Do While ファイル名 <> "" 貼付行 = 貼付行 + 1 Cells(貼付行, 1).Value = ファイル名 ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=ファイル名, TextToDisplay:=ファイル名 ファイル名 = Dir() Loop End Sub 実行すると初めの一行だけリンクができ後は一行もできません。よろしくお願い致します。
- ベストアンサー
- その他（プログラミング・開発）
- 【VBA】sleepかwaitをどこに書き込めば
ExcelでWebスクレイピングを行うための、VBAのソースをご教示頂きました。 過去の質問｜https://okwave.jp/qa/q9420082.html このソースは完璧に動くのですが、googleに負荷を掛けてしまい、100件ほど抽出するとエラーが出て使えなくなってしまいます。 そこでsleepやwaitを使って、間隔を空けて実行させたいと考えています。 以下のどの部分に追加すれば良いのか、教えてください！ お願い致します。 ――――――――――――――――――― ' Option Explicit ' Sub Macro1() ' Dim SheetW As Worksheet Dim SheetO As Worksheet Dim Start As Integer Dim URL As String Dim NowCell As String Dim RowI As Integer Dim RowO As Integer Dim RowEnd As Integer Dim Col As Integer Dim ColEnd As Integer ' Set SheetO = ActiveSheet [A10:C10] = Array("番号", "URL", "説明") [A11:C1048576].Clear Set SheetW = Sheets.Add SheetW.Name = "Webクエリ" RowO = 11 ColEnd = [A5].End(xlToRight).Column ' For Start = SheetO.[B2] To SheetO.[C2] Step SheetO.[D2] DoEvents URL = SheetO.[B1] & SheetO.[C1] & SheetO.[D1] & Start With ActiveSheet.QueryTables.Add( _ Connection:="URL;" & URL, _ Destination:=[A1]) .Name = "Google検索結果" .WebSelectionType = xlEntirePage .WebFormatting = xlWebFormattingAll .BackgroundQuery = False .Refresh End With ' With SheetO RowI = [A:A].Find(.[B3]).Row + 1 RowEnd = Cells(Rows.Count, "A").End(xlUp).Row While Not Cells(RowI, "A") Like .[B4] And _ RowI < RowEnd NowCell = Cells(RowI, 1) ' For Col = 2 To ColEnd ' If NowCell Like .Cells(5, Col) Then Exit For End If Next Col ' If Cells(RowI, 1).Hyperlinks.Count > 0 And Col > ColEnd Then .Cells(RowO, "A") = RowO - 10 .Cells(RowO, "C") = NowCell NowCell = Cells(RowI, "A").Hyperlinks(1).Address ' SheetO.Cells(RowO, "B") = NowCell .Hyperlinks.Add Anchor:=.Cells(RowO, "B"), _ Address:=NowCell, _ TextToDisplay:=NowCell RowO = RowO + 1 End If RowI = RowI + 1 Wend End With Next Start ' "Webクエリ"シート削除 Application.DisplayAlerts = False SheetW.Delete Application.DisplayAlerts = True End Sub
- 締切済み
- Visual Basic
- ハイパーリンクの表示で質問の続きです。
これで大丈夫かな？ Sub test() Dim i As Long For i = 1 To Range("A65536").End(xlUp).Row Cells(i, 1).Hyperlinks(1).TextToDisplay = Cells(i, 1).Hyperlinks(1).Address Cells(i, 2).Value = Cells(i, 1).Hyperlinks(1).Address Next i End Sub ------------------- 有難うございました。完璧ですが、 ハイパーリンクのないセルのところでエラーになります。 ハイパーリンクのないセルは無視（エラーを無視）して次のセルの作業を指示したいのですが、・・・お願いします。 しばらくVBAを離れていまして思い出せません。すみません。
- ベストアンサー
- Visual Basic
- VBA(エクセル)のコンパイルエラー
お世話になります。 下記のマクロを記述したのですが、ウエから7行目の mid(Cells(i, colNum + 1).Value, 7, 11) のところで、下記のようなコンパイルエラーが出てしまいます。 試しに".Value"をとっても見ましたが、結果は同じでした。 どこをどう直せばよろしいのでしょうか、よろしくご指南くださいませ。 Sub mid_ac() Dim i As Integer Dim colNum As Integer i = 2 colNum = ActiveCell.Column Do Until Cells(i, 1).Value = "" Cells(i, colNum).Value = mid(Cells(i, colNum + 1).Value, 5, 10) i = i + 1 Loop End Sub コンパイルエラー： モジュールではなく、変数またはプロシージャを指定してください (ちなみに、このマクロは選択したセルの右隣にあるセルの左から5文字目～10文字目までを、表示させるものです。答えて下さる方には老婆心かもしれません。。。)
- 締切済み
- オフィス系ソフト
お礼
ありがとうございます。 もっと早く質問すればよかったです。 今日一日格闘してました。(^^;