• ベストアンサー
※ ChatGPTを利用し、要約された質問です(原文:「データを置き換えますか?」のメッセージ)

Excel VBAでデータを置き換える際に発生する問題と解決方法

このQ&Aのポイント
  • Excel VBAを使用してデータをSheet1に貼り付け、体裁調整のマクロを実行する際に「既にデータがあります。置き換えますか?」のメッセージが表示され、選択によってマクロの動作が異なる問題が生じています。
  • マクロの実行中に「OK」を選択するとデータが消える現象が起き、一方で「いいえ」を選択すると「RangeクラスのText To Columnsメソッドが失敗しました」というエラーメッセージが表示されて中断されます。
  • さらに別のシートで、特定の日付のみ残し、それ以外のデータを削除するマクロについても「型が一致しません」というエラーが出ています。具体的には前月の日付のみ残す処理でエラーが発生しています。

質問者が選んだベストアンサー

  • ベストアンサー
  • kon555
  • ベストアンサー率51% (1771/3407)
回答No.1

 まずデータ区切りについては、マクロは正常に作動していると思います。 「既にデータがあります。置き換えますか?」のメッセージはマクロ側ではなく、データ区切り機能のメッセージです。分割後のデータを表示させるセルに既にデータが入っている場合の注意換気ですね。 『右端2列のデータが消えてしまいます。』というあたりからすると、元データから想定より多くの分割数でデータが分割された結果、空白で上書きされているのでしょう。一度手動でデータ区切りを試してみて、どのように分割されているか確認してみるといいと思います。  場合によっては元データの修正などが必要になるでしょう。  次に「型が一致しません」というエラーですが、これはvba側の関数で、規定の型に対してしか実行できないのに違うデータ型に対して実行しようとした時に出るエラーです。  コードはザッとしか見ていないのですが、今月初めに作業をした時は正常に動作した、というところからすると問題はないでしょう。多分データ側に不備があると思います。日付として処理できないデータが入力されているんじゃないでしょうか。  元々空白だったり、文字列だったり、というデータです。その辺りを確認すると解決すると思います。  最後に、質問の内容からすると、業務でvbaは使用しているもののエエラーに対処する能力が低いようにお見受けします。  こうしたサイトでの解決には限界がありますし、そもそも的確な回答がつくとも限りませんので、エラー対応の方法を学習する事をおススメします。 https://www.excelspeedup.com/vbadebug/ https://www.tipsfound.com/vba/01010  要は「デバッグ」と言われる作業です。こうしたサイトで相談する場合にも、これがある程度行われていれば回答がつく可能性は上がります。  何より急ぎの業務だったりするケースを考えると、やはり自分で対応できるに越した事はありません。  お時間のあるときにでも勉強してみて下さい。

lunar-eclipce
質問者

お礼

早々にご回答を有り難うございます。 無事、実行することが出来ました。 データを見直したところ、 やはり挿入した列以上のスペースが 入力した文字のところどころに入っていました。 そちらを削除したところ、正常に動作するようになりました。 末尾にもスペースが入っていました。 日付の問題ですが、念のため入力をし直したところ こちらも無事解消致しました。 日付として処理できないものは入力されておらず、 空白セルもなく 解消できた理由がよくわかっておりませんが・・・。 VBA初心者でご指摘の通り、能力以上のことをしている自覚があります。 勉強を続けていきたいと思います。 本当に有り難うございました。

全文を見る
すると、全ての回答が全文表示されます。

関連するQ&A

  • 【Excel2013】特定のセルを指定したくない

    下記マクロはD8:D80までのセルに入力されている文字を「文字列」にするマクロです。 Range("D8:D80").Select Selection.TextToColumns Destination:=Range("D8"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _ Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _ :=Array(1, 2), TrailingMinusNumbers:=True Range("D8").Select End Sub 同じ作業を他のセルでも実行することが多々あるため、文字列にしたいセルを選択した状態でマクロを実行したいのです。 どのように設定すればよろしいのでしょうか?

  • エクセルのVBAで質問があります。

    現在自分はカレンダーを作成していて、カレンダーに祝日を入れたいと思っています そこで これを if文もしくはselectcase どっちを使ったら楽か教えてもらいたいです Sub MakeCalendar(hi As Date) Dim i As Integer 'カレンダーにセットする日付 Dim g As Integer '日付をセットする行番号 Dim r As Integer '日付をセットする列番号 Dim lastDay As Integer '作成するカレンダーの月末 g = 2 'その月の開始曜日を算出 r = Weekday(DateSerial(Year(hi), Month(hi), 1), vbSunday) '指定された日付の翌月1日をもとて、日付の前の日を計算する lastDay = Day(DateSerial(Year(hi), Month(hi) + 1, 1) - 1) For i = 1 To lastDay 'iに日付の設定 Cells(g, r).Value = i If r = 7 Then r = 1 '戻して g = g + 1 '1行下に書く Else r = r + 1 '1列→に移動する End If Next End Sub Sub test() Range("A2:G7").Value = "" 'A2~G2にカレンダー表示 MakeCalendar Range("I2").Value 'I2に日付を入力する End Sub Sub test() Range("A2:G7").Value = "" 'A2~G2にカレンダー表示 MakeCalendar Range("I2").Value 'I2に日付を入力する End Sub このようなマクロを組んでいまして、祝日(ゴールデンウィークなど)を赤で塗りつぶすような物を考えています。 VBAは初心者でまだあまりわかっていないので、ご教授ください

  • VBAでオーバーフローが出て困っています(エクセル2000です)

    自動売買ロボット作成マニュアルという本のなかに株価をダウンロードするためのプログラムとしてソースが書かれているのですが、オーバーフローとなってしまい、実行できません。lastrow = (Range("B4").End(xlDown).Row + 1)のところでオーバーフローを起こします。この文章だけでは対処できないと思いますのでプログラムを写します。 恐れ入りますが、お助けください。 Sub Calc() Dim code As String Dim data_length As Integer, date_temp As Date Dim day_s As Integer, month_s As Integer, year_s As Integer Dim day_e As Integer, month_e As Integer, year_e As Integer Dim row_length As Integer code = input_temp(2) data_length = -100 date_temp = DateAdd("d", data_length, Now) day_e = Day(Now) month_e = Month(Now) year_e = Year(Now) day_s = Day(date_temp) month_s = Month(date_temp) year_s = Year(date_temp) Range("B4:R65000").ClearContents For i = 0 To Abs(data_length) * 0.65 Step 50 If i = 0 Then lastrow = "4" For wtbl = 19 To 25 url = "URL;http://table.yahoo.co.jp/t?s=" & code & "&a=" & month_s & "&b=" & day_s & "&c=" & year_s & "&d=" & month_e & "&e=" & day_e & "&f=" & year_e & "&g=d&q=t&y=" & i & "&z=" & code & "&x=.csv" Call Get_Data If Range("B4") = "日付" Then Exit For Else Range("B4:H54").ClearContents End If Next Else url = "URL;http://table.yahoo.co.jp/t?s=" & code & "&a=" & month_s & "&b=" & day_s & "&c=" & year_s & "&d=" & month_e & "&e=" & day_e & "&f=" & year_e & "&g=d&q=t&y=" & i & "&z=" & code & "&x=.csv" lastrow = (Range("B4").End(xlDown).Row + 1) Call Get_Data Range("B" & lastrow, "H" & lastrow).Delete row_length = (Range("B4").End(xlDown).Row) If row_length - lastrow < 49 Then Exit For End If End If Next Range("B5:H65000").Sort Key1:=Range("B5") lastrow = Range("B4").End(xlDown).Row Range("B5", "B" & lastrow).NumberFormatLocal = "yyyy/mm/dd" Range("C5", "H" & lastrow).NumberFormatLocal = "0" Range("A1").Select End Sub Sub Get_Data() With ActiveSheet.QueryTables.Add(Connection:=url, Destination:=Cells(lastrow, 2)) .Name = "Yahoo" .FieldNames = False .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = False .RefreshPeriod = 0 .WebSelectionType = xlSpecifiedTables .WebFormatting = xlWebFormattingNone .WebTables = wtbl .WebPreFormattedTextToColumns = True .WebConsecutiveDelimitersAsOne = True .WebSingleBlockTextImport = False .WebDisableDateRecognition = False .Refresh BackgroundQuery:=False End With End Sub

  • VBA実行時のシート(複数)保護解除について

     いつも勉強させていただいております。VBA初心者です。  早速ですが、あるマクロを複数のシートで実行するとき、 シートに設定されている「シートの保護」を解除したいのですが、 複数シートに対しての処理方法が分かりません。  インターネットで検索した結果、 ActiveSheet.Unprotect を実行したいマクロの冒頭にセットし、 最後にActiveSheet.Protectを設定すればよいことは分かりました。 (私としての理解:こうすることで、シートの保護解除⇒保護となる。)  その結果、 Sub カレンダー作成() 'ワークシートを非保護にする ActiveSheet.Unprotect Dim 日付, i As Integer 日付 = Application.InputBox _ ("yyyy/m 形式の年月を半角で入力してください" & Chr(10) _ & " 例)2013年の1月 → 2013/1") Range("c3").Value = 日付 If 日付 = False Or IsDate(日付) = False Then Exit Sub For i = 1 To Sheets.Count With Sheets(i) Select Case .Name Case "sheet1", "sheet5" .Range("G5").Resize(, 31).ClearContents .Range("C3,G5").Value = DateSerial(Year(日付), Month(日付), 1) .Range("G5").AutoFill Destination:=.Range("G5"). _ Resize(, Day(DateSerial(Year(日付), Month(日付) + 1, 0))) End Select End With Next 'ワークシートを保護する ActiveSheet.Protect End Sub  と言った構文を作成し、1シートについての作業は成功しました。 ところが、2シート目以降にはエラーとなるのです。  この作業を、複数のシートに対して同時に、1回の操作で実行したいのです。 色々と調べてみて、それらしいサイトも見てみたのですが、初心者の私には、 その内容を理解し、自分のVBAに組み込むことが到底できませんでした。  有識者のみなさま、どうかご指導をよろしくお願いいたします。

  • エクセルで選択してるセルに決まった動作をマクロに

    いつもお世話になっております。 手動で選択したセルに対して決まった動作をさせたいのですが、マクロの記録では最初に選択したセル番地で動くことになるので困っています。 やりたいことは、例えばA列の5~6行目を選択して、そのセルの内容を文字区切りで横に展開したいのです。 これをマクロの記録では Sub Macro1() Range("A5:A7").Select Selection.TextToColumns Destination:=Range("A5"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _ Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _ :="\", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _ 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1)), TrailingMinusNumbers:=True End Sub となるのですが、この最初の行のRange("A5:A7”)Selectをその時に選んだセルで下のコードが実行されるようにしたいのですが。

  • Excel2010 VBAでスペース区切り

    はじめて質問させて頂きます。 VBA初心者ですが、宜しくお願いします。 CSVデータをエクセルにコピペしてから処理することを考えています。 CSVのデータはエクセルで開くと以下の様に入力されています。     |      A列      |  B列 |  C列 | 1行目|   日付 時刻    |データ1|データ2| 2行目|2014/5/14 13:00:01|  ○  |  △  | 3行目|2014/5/14 13:00:14|  ○  |  △  | 時刻は24h制で入力されています。 A列の日付と時刻の間にはスペースがあり、これをVBAでスペース区切りをしたいのです。 B列に列を追加し、スペース区切りの処理をしようと思い、自動記録すると以下のようになりました。 Sub Macro1()     Columns("B:B").Select     Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove     Columns("A:A").Select     Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _      TextQualifier:=xlNone, ConsecutiveDelimiter:=True, Tab:=True, Semicolon _      :=False, Comma:=False, Space:=True, Other:=False, FieldInfo:=Array( _      Array(1, 5), Array(2, 1)), TrailingMinusNumbers:=True End Sub ところが、このマクロを実行すると「コピーまたは移動先のセルの内容を置き換えますか?」のメッセージが表示されます。(記録する際には表示されませんでした。) 原因を探ったところ、自動記録のマクロを実行すると時刻が12時間制に変更されB列に、 C列にAM/PMが書き込まれます。(A列の日付は問題なく処理されます。) B列に24時間制の時刻が書き込まれるようにしたいのですが、 何か不足してるとことがあるのでしょうか? 方法を教えて下さい。 お手数ですが、宜しくお願いします。

  • VBAでWebクエリにて情報を自動収集するプログラム

    自動売買ロボット作成マニュアルという本を買いました。 これは株などを自動売買するプログラムを作るための方法が書いた本です。(言語はエクセルに搭載されてあるVBAというプログラム言語です) そのプログラムを作る過程で、まずYahoo!ファイナンスから株価などの情報を10年分自動収集するプログラムを作ったのですが、「インターネットサーバーに接続できません」と出て、きちんと実行できません。 そこで、デバックをすると.Refresh BackgroundQuery:=Falseというプログラムのところがチェックされました。どうしたらいいでしょうか? この文章だけでは対処できないと思いますのでプログラムを書いておきます。長々とお読みいただきありがとうございます。どうかお知恵をお貸しください。 Dim url As String Dim lastrow As Integer Dim i As Integer Sub Get_Data() With ActiveSheet.QueryTables.Add(Connection:=url, Destination:=Cells(lastrow, 2)) .Name = _ "t?s=998407.o&a=4&b=22&c=2008&d=7&e=24&f=2008&g=d&q=t&y=0&z=998407.o&x=_1" .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 = "19" .WebPreFormattedTextToColumns = True .WebConsecutiveDelimitersAsOne = True .WebSingleBlockTextImport = False .WebDisableDateRecognition = False .WebDisableRedirections = False .Refresh BackgroundQuery:=False End With End Sub Sub Calc() Dim code As String Dim data_length As Integer, date_temp As Date Dim day_s As Integer, month_s As Integer, year_s As Integer Dim day_e As Integer, month_e As Integer, year_e As Integer Dim row_length As Integer code = "998407.o" data_length = -3650 date_temp = DateAdd("d", data_length, Now) day_e = Day(Now) month_e = Month(Now) year_e = Year(Now) day_s = Day(date_temp) month_s = Month(date_temp) year_s = Year(date_temp) Range("B4:H65000").ClearContents For i = 0 To Abs(data_length) * 0.65 Step 50 url = "URL; http://table.yahoo.co.jp/t?s=" & code & "&a=" & month_s & "&b=" & day_s & "&c=" & year_s & "&d=" & month_e & "&e=" & day_e & "&f=" & year_e & "&g=d&q=t&y=" & i & "&z=" & code & "&x=.csv" If i = 0 Then lastrow = "4" Call Get_Data If Range("B4") = "" Then Exit Sub End If Else lastrow = (Range("B4").End(xlDown).Row + 1) Call Get_Data Range("B" & lastrow, "H" & lastrow).Delete row_length = (Range("B4").End(xlDown).Row) If row_length - lastrow < 49 Then Exit For End If End If Next Range("B5:H65000").Sort Key1:=Columns("B") lastrow = Range("B4").End(xlDown).Row Range("B5", "B" & lastrow).NumberFormatLocal = "yyyy/mm/dd" Range("C5", "H" & lastrow).NumberFormatLocal = "0" Range("A1").Select End Sub

  • 実行時エラー'1004': アプリケーション定義またはオブジェクト定義

    実行時エラー'1004': アプリケーション定義またはオブジェクト定義について Dim code As String Dim lastrow As Integer Dim i As Integer Sub calc() Dim code As String Dim day_s As Integer, month_s As Integer, year_s As Integer Dim day_e As Integer, month_e As Integer, year_e As Integer Dim row_length As Integer code = "998407.o" day_e = 31 month_e = 12 year_e = 2005 day_s = 1 month_ = 1 year_s = 2005 Range("B4:H65536").ClearContents For i = 0 To 365 * 0.65 Step 50 URL = "URL;http://table.yahoo.co.jp/t?s=" & code & "&a=" & month_s & "&b=" & day_s & "&c=" & year_s & "&d=" & month_e & "&e=" & day_e & "&f=" & year_e & "&g=d&q=t&y=" & i & "&z=" & code & "&x=.csv" If i = 0 Then lastrow = 4 Call GETデータ If Range("B4") = "" Then Exit Sub End If Else lastrow = Range("B4").End(xlDown).Row + 1 Call GETデータ Range("B" & lastrow, "H" & lastrow).Delete row_length = Range("B4").End(xlDown).Row If row_length - lastrow < 49 Then Exit For End If End If Next Range("B5:H65536").Sort key1:=Columns("B") lastrow = Range("B4").End(xlDown).Row Range("B5", "B" & lastrow).NumberFormatLocal = "yyyy/mm/dd" Range("A1").Select End Sub もうひとつ Sub GETデータ() With ActiveSheet.QueryTables.Add(Connection:=URL, Destination:=Cells(lastrow, 2)) ↑ここにデバックで黄色になります。 .Name = "t?s=998407.o&g=d" .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 = "10" .WebPreFormattedTextToColumns = True .WebConsecutiveDelimitersAsOne = True .WebSingleBlockTextImport = False .WebDisableDateRecognition = False .WebDisableRedirections = False .Refresh BackgroundQuery:=False End With End Subになります。Excel2007です。

  • エクセルのマクロ実行→オブジェクトがはみでるエラーについて

    エクセルでマクロを作り、実行したのですが、データを集計し「2」で集約する部分で「オブジェクトからはみでます」というエラーがでます。原因がわかりません。正しく実行できる方法を教えてください。 Selection.Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Array(3, 4, 5, 6, _ 7, 8, 10, 13), Replace:=True, PageBreaks:=False, SummaryBelowData:=False Range("D2").Select   ↓この部分でエラーになります。 ActiveSheet.Outline.ShowLevels RowLevels:=2 Range("A2").Select Selection.Insert Shift:=xlDown Range("P2:R2").Select Selection.Insert Shift:=xlDown Range("B1").Select Selection.SpecialCells(xlCellTypeVisible).Select Selection.Copy

  • Excel VBでのデータの取り込み方

    Excel VBを使って、デスクトップにあるcsv形式のデータを取り込むマクロを作りました(「マクロの記録」にて)。データは10個あるので、同じようなマクロを10個作っています。 そこで、取り込むcsvのファイル名ですが、01.csv、02.csv、…、10.csvという名前になるように1つ1つ名前の変更をしてから取り込んでいます。 これをもとのファイル名のままで、番号の若いもの順から取り込むということは出来ないでしょうか。 元のファイル名は「1002.csv」「1234.csv」「3456.csv」などと「(4ケタの数字).csv」です。 今、使っているVBは以下の通りです(長くてすみません)。 どうぞよろしくお願いいたします。 ------------------------------------------------------------------------ Sub data01取り込み() ' ' data01取り込み Macro ' ' Sheets("data1").Select Range("A1").Select With ActiveSheet.QueryTables.Add(Connection:= _ "TEXT;C:\Users\user\Desktop\データ\01.csv", Destination:=Range("$A$1")) .Name = "cell1" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .TextFilePromptOnRefresh = False .TextFilePlatform = 932 .TextFileStartRow = 1 .TextFileParseType = xlDelimited .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = False .TextFileTabDelimiter = True .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = True .TextFileSpaceDelimiter = False .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1) .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False End With Range("E2:E400").Select Selection.Copy Sheets("計算").Select ActiveWindow.SmallScroll Down:=-16 Range("e4").Select ActiveSheet.Paste End Sub ----------------------------------------------------------------

このQ&Aのポイント
  • 引っ越しに伴い、モデルルーターを変更したらWiFi接続(WPS)ができなくなりました。WiFi接続(WPS)で接続を選択しても、「WPSまたはAOSS設定中の無線LANアクセスポイントが2台以上みつかりました」(Error:TS-08)というエラーメッセージが出ます。セツゾクウィザードからIDとPASSを入力して一旦はConnection:okとは出ますが、その後どのPCからもモノクロレーザー自体がオフラインですと出ます。PCのソフトをアンインストールし、インストールしようとしても製品がオフラインですと出るため、先に進みません。どうしたらよいでしょうか?(因みに有線LANは上手く作動しません)
  • ご質問は、WiFi接続(WPS)ができなくなった状況についてです。引っ越し後にモデルルーターを変更したところ、WPS接続ができないというエラーが表示されています。セツゾクウィザードでの接続は一度成功するものの、その後PCから印刷機がオフラインになってしまい、インストールも進められません。有線LAN接続には問題がないとのことですが、WiFi接続(WPS)を正常に行うための解決策をご相談されたいようです。
  • 質問内容は、モデルルーターの変更に伴いWiFi接続(WPS)ができなくなってしまったというものです。WPS接続を選択しても「WPSまたはAOSS設定中の無線LANアクセスポイントが2台以上見つかりました」(Error:TS-08)というエラーメッセージが表示されます。一度はセツゾクウィザードで正常な接続ができるのですが、その後どのPCからも印刷機がオフラインとなります。有線LAN接続は正常に作動しない状態です。この問題の解決方法をお知りになりたいとのことです。
回答を見る

専門家に質問してみよう