• ベストアンサー

連続するセルの比較をしたいのですが、(型が一致しません)のエラーが出ます。

 下記のどの部分でエラーになるのか、お教えください よろしくお願いします。  Sub CellsSamp() Sheets("sheet3").Select If Range(Cells(5, 1), Cells(5, 6)) = Range(Cells(5, 8), Cells(5, 25)).Value Then Range(Cells(6, 1), Cells(6, 6)) = Range(Cells(5, 1), Cells(5, 6)).Value End If End Sub

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

  • ベストアンサー
  • norakuma
  • ベストアンサー率29% (293/977)
回答No.5

Sub てすと() Dim strX(7)  '元データの配列 Dim strA(13) '比較データの配列 Dim strY '配列をつなげた文字列(元) Dim strB '配列をつなげた文字列(比較) Dim i, n 'ループ用 '(5,1)-(5,6)までの文字列配列と '(5,8)-(5,13)までの文字列配列を作る。 For i = 1 To 6 strX(i) = Cells(5, i).Value n = i + 7 strA(n) = Cells(5, n).Value Next strY = Trim(Join(strX)) strB = Trim(Join(strA)) 'それぞれの文字列を比較。 'OKなら(7,1)-(7,6)まで数値を入れる。 If strY = strB Then strX(7) = Split(strY) For i = 1 To 6 Cells(7, i).Value = strX(i) Next Else MsgBox "だめ" End If End Sub JoinとSplitが好きなんで、一度配列を作って、 配列ごと比較するアルゴリズムにしました。 動作するのは確認しました。 一文字ずつ比較するやりかたもありますけど。

takagon
質問者

お礼

norakumaさん 大変すばらしい御回答をいただき有難う ございました。早速テストさせていただき思っている動作が出来て感激です。 本当に有難うございます。

その他の回答 (7)

  • BlueRay
  • ベストアンサー率45% (204/453)
回答No.8

遅くなったので、既に回答は出ているようですね。 一応、当方の回答を書いておきます。 当方は、Instr関数をよく使用するのでInstrを使用した例です。 Sub CellsSamp()   Dim i As Integer 'ループ用   Dim bStart As Long, bEnd As Long '比較対照元開始・終了   Dim tStart As Long, tEnd As Long 'ターゲット開始・終了   Dim bStr As String '比較対照元文字列   Dim tStr As String 'ターゲット文字列      bStart = 1   bEnd = 6   tStart = 8   tEnd = 25      '比較対照元範囲のセルの内容を1文字列として結合   For i = bStart To bEnd    bStr = bStr & Cells(5, i)   Next   'ターゲット範囲のセルの内容を1文字列として結合   For i = tStart To tEnd    tStr = tStr & Cells(5, i)   Next   'ターゲット文字列中に比較対照元文字列が含まれるかチェック   '含まれていれば、開始位置が帰ってきて含まれていなければ0   If InStr(tStr, bStr) > 0 Then    Range(Cells(6, bStart), Cells(6, bEnd)) = Range(Cells(5, bStart), Cells(5, bEnd)).Value   End If End Sub

takagon
質問者

お礼

BlueRayさん 大変詳しく御回答いただきまして 有難うございます。皆様の回答を参考にさせていただき、 さらに勉強させていただきます。 本当に有難う御座いました。

回答No.7

#2と#3です。 解決済みのようですが、くだらない回答しかしていなかったので、 私も1つサンプルを作りました。 参考になれば幸いです。 Sub test()   Dim Rn As Range   Dim Flg As Boolean 'チェックフラグ      Flg = True  '最初は全て一致している事にする      For Each Rn In Range(Cells(5, 1), Cells(5, 6))     'For Each Rn In Range("A5:F5") 'こちらでも同じ          If (Rn.Value <> Rn.Offset(, 7).Value) Then 'セルを比較       'Offset(,7)・・・Rnのセルの右へ7つ移動した場所       Flg = False '一致しない場合にフラグを変更       Exit For   'ループを抜ける     End If   Next Rn      If (Flg) Then  '一致していたら(Trueならば)     Range(Cells(7, 1), Cells(7, 6)) = Range(Cells(5, 1), Cells(5, 6)).Value   Else     MsgBox "一致していません"   End If End Sub #6さんの回答に似ていますが、こちらは先にチェックのみ行い、 後からチェック後の処理をしています。

takagon
質問者

お礼

taisuke555さん 大変ご丁寧にご回答を下さり感激しています。皆さんのご親切に感謝々です。 本当に有難う御座いました。

  • norakuma
  • ベストアンサー率29% (293/977)
回答No.6

#5です。 今度は一文字ずつのやりかたです。 #問題があるので、気をつけてください。 Sub てすと() Dim i, n For i = 1 To 6 n = i + 7 If Cells(5, i).Value = Cells(5, n).Value Then Cells(7, i).Value = Cells(5, i).Value Else Exit For End If Next End Sub これは、一致する限り一文字ずつ代入します。 一致しない場所でループを抜けますが、それまでの値は記入されます。 したがって、次のどちらかの回避策を組み込む必要があります。 1.どこか別の場所に値を保持して、最後までループが回ったかを確認して、一気にコピーする。 2.途中で一致しなくなったら、それまでに代入した値を全部削除。 これが面倒なら、配列単位で比較して値をセットする、この前のやりかたがよいです。

  • BlueRay
  • ベストアンサー率45% (204/453)
回答No.4

If Range(?, ?).Value = Range(?, ?).Value Then ↑条件比較は不可能です。 Range(?, ?).Value = Range(?, ?).Value ↑値の代入は可能です。 ※要するに、Range(?, ?).Valueを見ることは出来ません。 それでは、ここからが本題です。 具体的にどのようなことがしたいのでしょうか? 例えば、 Cells(5, 1) = "A" Cells(5, 2) = "B" Cells(5, 3) = "C" Cells(5, 4) = "D" Cells(5, 5) = "E" Cells(5, 6) = "F" として Range(Cells(5, 1), Cells(5, 6))は、"ABCDEF"と見えているとします。 そして、やりたいことは Range(Cells(5, 8), Cells(5, 13))の範囲に"ABCDEF"と言う並びでの有無をIf文でチェックしたいと言うことでよろしいのでしょうか? 根本的に今の文では解決できないので、やりたいことをもう少しわかりやすく補足していただければ別な方法での回答が得られるようになると思いますよ。

takagon
質問者

補足

BlueRayさん 大変ご親切な回答有難うございます。 初心者で申し訳ありません。 ご指摘のように、Cells(5,1)~Cells(5,6)に"A,B,C,D,E,F" Cells(5,8)~Cells(5,13)に"A,B,C,D,E,F"と、ある時 IF文でチェックして同じなら、Cells(7,1)~Cells(7,6)に "A,B,C,D,E,F"を表示したいのです。 ぜひ ご教示ください。

回答No.3

どんなエラーかタイトルに書いてありましたね。 失礼しました。

takagon
質問者

お礼

taisuke555さん 有難うございました。 色々試行錯誤を繰り替えしていますが、なかなか完成しません。 これからもよろしくお願いします。

回答No.2

If Range(Cells(5, 1), Cells(5, 6)) = Range(Cells(5, 8), Cells(5, 25)).Value Then この書き方ができるのかどうかは未確認ですが、 (1)比較するセルの大きさが違いますよね? (2)後半のRangeには.Valueがありますが、    前半にはないですよね? これは、意図的に記述しているのでしょうか? どんなエラーが出るのかも書くと回答者も答えやすいと思いますよ。

  • kojitti
  • ベストアンサー率32% (449/1386)
回答No.1

ここで出ています。 If Range(Cells(5, 1), Cells(5, 6)) = Range(Cells(5, 8), Cells(5, 25)).Value Then ステップ実行(F8キー押下)させてばどこでエラーになっているかすぐわかりますよ。

takagon
質問者

補足

kojittiさん、早速の回答ありがとうございます。 質問文が足りませんでした。 If Range(Cells(5, 1), Cells(5, 6)) = Range(Cells(5, 8), Cells(5, 25)).Value Then エラーの部分をどの様に修正したら良いかお教えください。

関連するQ&A

  • VBA エクセル 実行時エラー13:型が一致しません

    またまたお世話になります。 下記のマクロを走らせると、タイトルのようなエラーメッセージが出てしまいます。 Sub rows_hdn() Dim n As Integer Sheets("ABC").Select n = 3 Do Until Cells(n, 2).Value = "" n = n + 1 Loop Sheets("EFG").Select If n <> 3 Then Rows("3:n-1").Select Selection.EntireRow.Hidden = True End If End Sub シートABCに入力がされているライン数だけ、シートEFGの3行目から隠したいのですが、どのようにすればよろしいのでしょうか? よろしくお願いいたします。

  • 型が一致しません

    いつもお世話になっております。 シートごとに元データの値でフィルタをかけ、 フィルタした各シートのD列の文字列を照らし合わせて整合性を確認したく、 下記のようなVBAをつくりましたが、ここで↓ If name_A <> name_B <> name_C <> name_D Then 型が一致しませんとエラーになります。 どなたかアドバイスをお願いいたします。 Sub 不整合チェック()  'フィルター  Worksheets("Aリスト").Select  If ActiveSheet.AutoFilterMode = True Then Selection.AutoFilter  Range("B4").AutoFilter  Selection.AutoFilter field:=1, Criteria1:=Worksheets("元データ").Range("C3")  Worksheets("Bリスト").Select  If ActiveSheet.AutoFilterMode = True Then Selection.AutoFilter  Range("B4").AutoFilter  Selection.AutoFilter field:=1, Criteria1:=Worksheets("元データ").Range("C3")  Worksheets("Cリスト").Select  If ActiveSheet.AutoFilterMode = True Then Selection.AutoFilter  Range("B4").AutoFilter  Selection.AutoFilter field:=1, Criteria1:=Worksheets("元データ").Range("C3")  Worksheets("Dリスト").Select  If ActiveSheet.AutoFilterMode = True Then Selection.AutoFilter  Range("B4").AutoFilter  Selection.AutoFilter field:=1, Criteria1:=Worksheets("元データ").Range("C3") '整合性チェック  Dim name_A As String  Dim name_B As String  Dim name_C As String  Dim name_D As String  name_A = Worksheets("Aリスト").Cells(65536, 4).End(xlUp).Value  name_B = Worksheets("Bリスト").Cells(65536, 4).End(xlUp).Value  name_C = Worksheets("Cリスト").Cells(65536, 4).End(xlUp).Value  name_D = Worksheets("Dリスト").Cells(65536, 4).End(xlUp).Value  If name_A <> name_B <> name_C <> name_D Then   MsgBox "データ不整合を発見しました。 処理を中断します。", vbCritical   Exit Sub  ElseIf mykouiji_kouji = name_nyukin = name_kokyaku = name_uriage Then   MsgBox "問題なし。"  End If End Sub

  • Excel VBA セルの双方向同期のエラーについ

    エラーが発生して理由がわからないので、どなたか助言をお願いします。 以下のVBAにて、目的のセルにデータを入力すると、1回目は必ず添付写真の通りのエラーが出まして、デバッグをすると3行目が黄色でハイライトされます。 記述は以下の通りです。どうぞよろしくお願いします。 シートAへのVBA設定 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$A$1" Then Sheets("シートB").Range("$B$1").Value = Sheets("シートA").Range("$A$1").Value End If End Sub シートBへのVBA設定 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$B$1" Then Sheets("シートA").Range("$A$1").Value = Sheets("シートB").Range("$B$1").Value End If End Sub

  • 型が一致しない というエラー

    Private Sub Worksheet_Change(ByVal Target As Range) If Target = Range("B1") Then Range("B3:B8").Select Selection.ClearContents End If End Sub というコードを書いています。 B3~B8は「数字」という書式です。 型が一致しない13番のエラーが出ます。 原因と対処法を教えてください。 宜しくお願いします。

  • 実行時エラー13 型が一致しません。エラー2029

    エクセルです。 A1に「=a」と文字が入っていて、 #NAME? となります。 その状態でvbaで セルA1に「=a」が入っているのなら としたい為、 Sub test() If Cells(1, 1) = "=a" Then End If End Sub こうしたのですが、 実行時エラー13 型が一致しません。 になります。 vba中断中に、Cells(1, 1)の部分にマウスカーソルを当ててみると エラー 2029 となっています。 If Cells(1, 1) = "=a" Then が無理なら、 If Cells(1, 1) = "#NAME?" Then なら行けるかな?と思いましたが、 全く同じエラーになります。 最終的に何がやりたいかと言うと、 Sub test() If Cells(1, 1) = "=a" Then Rows(1).delele End If End Sub のように、#NAME?の場合は、その行を削除したいです。

  • excel;マクロ;表現をもっと縮小したい

    質問します。下記のようなモジュールで中に同様の数字のみが順に変わるブロック繰り返しが多数あるのですが、もっと簡略化した表現 が可能でしょうか。よろしくお願いします。 Sub usb_count() d = Range("A65536").End(xlUp).Row j = 3 For i = 2 To d Select Case Cells(i, "B") Case Sheets("sheet2").Cells(4, "A") Sheets("sheet2").Cells(4, "B").Value = Sheets("sheet2").Cells(4, "B").Value + 1 If Cells(i, "K").Value = "USB" Then Sheets("sheet2").Cells(4, "C").Value = Sheets("sheet2").Cells(4, "C").Value + 1 Else Sheets("sheet2").Cells(4, "D").Value = Sheets("sheet2").Cells(4, "D").Value + 1 ' End If ‘------------------------------------------------------------------------------------------------------------------------------------ Case Sheets("sheet2").Cells(5, "A") Sheets("sheet2").Cells(5, "B").Value = Sheets("sheet2").Cells(5, "B").Value + 1 If Cells(i, "K").Value = "USB" Then Sheets("sheet2").Cells(5, "C").Value = Sheets("sheet2").Cells(5, "C").Value + 1 Else Sheets("sheet2").Cells(5, "D").Value = Sheets("sheet2").Cells(5, "D").Value + 1 End If ‘----------------------------------------- ‘以下上記の‘-----------から‘-----------で囲まれたブロックが( )内の数字が6から20まで繰り返され続く が略す End Select Next i End Su

  • エクセル マクロ チェックボックス

    sheet1にチェックボックスが3つあり、マクロを実行するコマンドボタンが1つあります。 チェックボックスにレ点を入れることにより、sheet4のデータからsheet2にグラフを作成しようと考えてますが、エラーが出てしまい解決できません。 どのように訂正したらいいのか教えて頂けないでしょうか。 Private Sub CommandButton1_Click() Dim GraphRange As String Dim Graph As ChartObject Dim lastRow As Long Set Graph = Sheets("sheet2").ChartObjects.Add(150, 27, 350, 200) lastRow = Sheets("sheet4").Range("A" & Rows.Count).End(xlUp).Row GraphRange = Sheets("sheet4").Range(Cells(1, 1), Cells(lastRow, 1)).Value If Sheets("sheet1").CheckBox1.Value = True Then 'CheckBox1にチェックがあれば GraphRange = Sheets("sheet4").Range(Cells(1, 2), Cells(lastRow, 2)).Value End If If Sheets("sheet1").CheckBox2.Value = True Then 'CheckBox2にチェックがあれば GraphRange = Sheets("sheet4").Range(Cells(1, 3), Cells(lastRow, 3)).Value End If If CheckBox3.Value = True Then 'CheckBox3にチェックがあれば GraphRange = Sheets("sheet4").Range(Cells(1, 4), Cells(lastRow, 4)).Value End If Graph.Chart.ChartWizard Source:=Sheets("sheet4").Range(GraphRange).Value, _ Gallery:=xlLine, Format:=1, PlotBy:=xlColumns, _ CategoryLabels:=1, SeriesLabels:=1, HasLegend:=True End Sub

  • Next,End Withのエラー

    Sub 入力() If Sheets("入力").Range("D3").Value = "" Then MsgBox "客先名を入力して下さい" Else Dim K最終行 As Long Dim T最終行 As Long Dim i As Integer With Sheets("入力") For i = 3 To 12 If .Cells(i, "H").Value <> "" Then U最終行 = Sheets("注文書").Range("G65536").End(xlUp).Row + 1 If U最終行 = 461 Then MsgBox "注文書がいっぱいです" Exit Sub Else End If E最終行 = Sheets("営業確認").Range("G65536").End(xlUp).Row + 1 Sheets("営業確認").Range("k" & E最終行).Value = .Cells(i, "b").Value Sheets("営業確認").Range("b" & E最終行).Value = .Cells(i, "c").Value Sheets("営業確認").Range("c" & E最終行).Value = .Cells(i, "d").Value Sheets("営業確認").Range("d" & E最終行).Value = .Cells(i, "e").Value Sheets("営業確認").Range("g" & E最終行).Value = .Cells(i, "h").Value Sheets("営業確認").Range("f" & E最終行).Value = .Cells(i, "i").Value Sheets("営業確認").Range("i" & E最終行).Value = .Cells(i, "m").Value Sheets("営業確認").Range("h" & E最終行).Value = .Cells(i, "p").Value Else End If Select Case .Cells(i, "o").Value Case "北" K最終行 = Sheets("北").Range("h65536").End(xlUp).Row + 1 Sheets("北").Range("B" & K最終行).Value = .Cells(3, "C").Value Sheets("北").Range("c" & K最終行).Value = .Cells(3, "b").Value Case "中" T最終行 = Sheets("中").Range("H65536").End(xlUp).Row + 1 Sheets("中").Range("b" & T最終行).Value = .Cells(3, "c").Value Sheets("中").Range("c" & T最終行).Value = .Cells(3, "b").Value End Select Exit Sub Dim Dummy As Worksheet Dim SheetName As String Dim OTA As Long Dim GEN As Long Dim SheetName2 As String With Sheets("入力") '3行目~22行目まで For j = 3 To 22 SheetName = Sheets("入力").Range("D3").Value On Error Resume Next Set Dummy = Sheets(SheetName) SheetName2 = .Cells(i, 14).Value 'もしシートがあれば・・・ If Err.Number = 0 Then 'SheetName2は入力シートのN行 SheetName2 = .Cells(i, 14).Value OTA = Sheets(SheetName2).Range("B65536").End(xlUp).Row + 1 Sheets(SheetName2).Range("A7").Value = .Cells(3, "D").Value Sheets(SheetName2).Range("C3").Value = .Cells(3, "C").Value Sheets(SheetName2).Range("B" & OTA).Value = .Cells(i, "H").Value Sheets(SheetName2).Range("I" & OTA).Value = .Cells(i, "I").Value Sheets(SheetName2).Range("F" & OTA).Value = .Cells(i, "K").Value Sheets(SheetName2).Range("H" & OTA).Value = .Cells(i, "L").Value Sheets(SheetName2).Range("J" & OTA).Value = .Cells(i, "M").Value 'シートが無ければ・・・ Else GEN = Sheets("原紙").Range("B65536").End(xlUp).Row + 1 Sheets("原紙").Range("A7").Value = .Cells(3, "D").Value Sheets("原紙").Range("C3").Value = .Cells(3, "C").Value Sheets("原紙").Range("B" & GEN).Value = .Cells(i, "H").Value Sheets("原紙").Range("I" & GEN).Value = .Cells(i, "I").Value Sheets("原紙").Range("F" & GEN).Value = .Cells(i, "K").Value Sheets("原紙").Range("H" & GEN).Value = .Cells(i, "L").Value Sheets("原紙").Range("J" & GEN).Value = .Cells(i, "M").Value '原紙をコピーする Sheets("原紙").Copy BEFORE:=Sheets(1) 'シートの名前を市場コードにする Sheets(1).Name = SheetName Next End With Exit Sub On Error GoTo 0 Sheets("原紙").Select Range("C3:E3,A7,B16:B35,F16:F35,H16:J35").Select Range("H35").Activate Selection.ClearContents Sheets("入力").Select Sheets("入力").Range("D3,G3:J12,L3:M12").Value = "" Sheets("入力").Range("D3").Select Range("B3").Formula = "=IF(D3="""","""",VLOOKUP(D3,'\\Seika-sv01\支店共有\マーケティング用\[担当者リスト.xls]リスト形式'!$B:$D,3,FALSE))" MsgBox "入力が完了しました" End If End Sub 上記のようにマクロを組みましたがエラーが出てしまいます。

  • EXCEL VBA エラーの意味が分からず

    いつも、お世話になっております。 下記コードで、レコード1と2を前へと次へを繰り返し何度か操作すると、エラーになってしまいます。なぜエラーになって、どう修正すれば回避できるのかが分かりません。 どうかご教授いただけないでしょうか。よろしくお願いいたします。 エラーの状況 inputシートで、maeとtsugiの動作を何度か行うと、「If pict.TopLeftCell.Address = targetRange.Address Then」の部分が黄色く塗りつぶされ、「実行時エラー1004 アプリケーション定義またはオブジェクト定義のエラーです。」と表示されてしまします。たぶん写真の削除の時にエラーになっているのだと思いますが、 '■標準モジュールのコード。dataシートのレコードを移動し、inputシートのBC1セルに表示する。 Public trg As Range Sub Saisyo() Set trg = Worksheets("data").Range("A1") Do Set trg = trg.Offset(1, 0) Loop Until trg.EntireRow.Hidden = False Call Tenki End Sub Sub Saigo() Set trg = Worksheets("data").Range("A60000").End(xlUp) Call Tenki End Sub Sub Mae() On Error GoTo errhandle If trg.row >= 3 Then Do Set trg = trg.Offset(-1, 0) Loop Until trg.EntireRow.Hidden = False If trg.row = 1 Then MsgBox "これより前のレコードはありません" Call Saisyo Exit Sub Else Call Tenki End If Else MsgBox "これより前のレコードはありません!" End If Exit Sub errhandle: Call Saisyo End Sub Sub Tsugi() On Error GoTo errhandle If trg.row < Worksheets("data").Range("A60000").End(xlUp).row Then Do Set trg = trg.Offset(1, 0) Loop Until trg.EntireRow.Hidden = False Call Tenki Else MsgBox "これより後ろのレコードはありません" End If Exit Sub errhandle: Call Saigo End Sub Sub Tenki() Worksheets("input").Range("BC1").Value = trg.Offset(0, 0) End Sub '■sheet 1のモジュール。inputシートBC1セルの値を見て、dataシートへ値を読みにいき、inputシートへ表示する。 Private Sub hyouji() Dim fRange As Range Dim kensaku As Long Set fRange = Sheets("data").Columns(1).Find(What:=Range("BC1").Value, _ LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows) If (fRange Is Nothing) Then '見つからなかった? MsgBox "入力された顧客コードが存在しません。", vbExclamation Exit Sub End If kensaku = fRange.row '検索された顧客DCの行位置を求める Range("BC1:BE1").Value = Sheets("data").Cells(kensaku, 1).Value '整理No Range("AX1").Value = Sheets("data").Cells(kensaku, 2).Value '固有ID Range("I4").Value = Sheets("data").Cells(kensaku, 3).Value '工場名 Range("P4").Value = Sheets("data").Cells(kensaku, 4).Value '柱No Range("W4").Value = Sheets("data").Cells(kensaku, 5).Value '盤No Range("I5").Value = Sheets("data").Cells(kensaku, 6).Value '変台系統1 Range("S5").Value = Sheets("data").Cells(kensaku, 7).Value '変台系統2 Range("I6").Value = Sheets("data").Cells(kensaku, 8).Value '分電盤設置時期 Range("B8").Value = Sheets("data").Cells(kensaku, 9).Value '主な供給先 Range("B14").Value = Sheets("data").Cells(kensaku, 10).Value '特記 Range("AD4").Value = Sheets("data").Cells(kensaku, 11).Value '盤位置の目安 Range("AT8").Value = Sheets("data").Cells(kensaku, 12).Value '幹線線相 Range("R36").Value = Sheets("data").Cells(kensaku, 13).Value '盤写真ファイル名 Range("AT36").Value = Sheets("data").Cells(kensaku, 14).Value '単結図ファイル名 End Sub '■sheet 1のモジュール。"$R$36"と"$AT$36"の写真ファイル名を見て、"C37"と"AE37"セルに表示させる。 Private Sub Worksheet_Change(ByVal Target As Range) Dim fRange As Range Dim touroku As Long Select Case Target.Address Case "$BC$1" Call hyouji Case "$R$36" myLoadPicture "board_Image", Target.Text, Range("C37") Case "$AT$36" myLoadPicture "map_Image", Target.Text, Range("AE37") Case "$AT$8" Call red_circle Case Else Exit Sub End Select End Sub Private Sub myLoadPicture(folderName As String, fname As String, targetRange As Range) Dim pict As Shape, picPath As String picPath = ThisWorkbook.Path & "\" & folderName & "\" & fname If fname = "" Then picPath = ThisWorkbook.Path & "\" & folderName & "\" & "NoImage.jpg" End If With ActiveSheet For Each pict In .Shapes If pict.TopLeftCell.Address = targetRange.Address Then pict.Delete Exit For End If Next pict Set pict = .Shapes.AddPicture(picPath, msoTrue, msoFalse, _ targetRange.Left, targetRange.Top, 300, 360) End With End Sub

  • 実行時エラー1004空白セルを上に詰める

    よろしくお願いします いろいろ試しましたが解決できませんでした。 Private Sub CommandButton1_Click() With Worksheets("Sheet1") For r = 2 To .Cells(Rows.Count, "C").End(xlUp).Row If .Cells(r, "C").Value = 提出先.Value Then Me.提出先.Value = "" .Cells(r, "C").Value = "" Else End If Next r .Range("J3").Value = "" ’下記の構文でエラーが出ます ’実行時エラー1004 ’アプリケーション定義またはオブジェクト定義のエラーです .Range(Range("C2"), Cells.SpecialCells(xlCellTypeLastCell)).SpecialCells (xlCellTypeBlanks).Delete Shift:=xlUp End With End Sub

専門家に質問してみよう