エクセルのマクロについて

前へ 次へ
このQ&Aのポイント
  • エクセルのマクロについて質問です。特定の範囲内で条件に当てはまるセルがある場合に、メッセージボックスを表示したいと思っていますが、空白のセルに関してはメッセージボックスを表示しないようにしたいです。具体的な方法を教えてください。
  • エクセルのマクロで特定の範囲内で条件に当てはまるセルをチェックする方法について教えてください。また、メッセージボックスでの表示方法も教えてください。
  • エクセルのマクロで特定の条件に当てはまるセルを検索し、メッセージボックスで表示する方法を教えてください。空白のセルに関しては表示しないようにしたいです。
回答を見る
  • ベストアンサー

エクセルのマクロについて

下記は、A列3行の7文字目～10文字と B列5行～文字のある最後の行までの範囲の左から1文字目～4文字 に相違がある場合 MsgBox i ＆ “行目” を出す。 というマクロなのですが、『B列5行～文字のある最後の行までの範囲』の中でも『空白のセルに関してはMsgBox不要』というふうに付加えたいのですがどのようにすればよいでしょうか。 Sub Macro1() Dim i As Long Dim sOrgText As String Dim ltotal As Long With ActiveSheet sOrgText = Mid(.Cells(3, 1), 7, 4) ltotal = .Cells(65536, 2).End(xlUp).Row For i = 5 To ltotal If Not Mid(.Cells(i, 2), 1, 4) = sOrgText Then MsgBox i & "行目" End If Next i End With End Sub

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

  • ベストアンサー
noname#147912
noname#147912
回答No.1

Sub Macro1() Dim i As Long Dim sOrgText As String Dim ltotal As Long With ActiveSheet sOrgText = Mid(.Cells(3, 1), 7, 4) ltotal = .Cells(65536, 2).End(xlUp).Row For i = 5 To ltotal If Mid(.Cells(i, 2), 1, 4) <> sOrgText And _ Replace(.Cells(i, 2), " ") <> "" And _ Replace(.Cells(i, 2), "　") <> "" Then MsgBox i & "行目" End If Next i End With End Sub これでどうでしょうか。

  1. カテゴリ
  2. ビジネス・キャリア
  3. 職種
  4. SE・インフラ・Webエンジニア

関連するQ&A

  • エクセルのマクロについて

    Sub ア_Click() Dim i As Long With ActiveSheet For i = 5 To .Cells(Rows.count, "C").End(xlUp).Row If InStr(.Cells(i, "C"), "ア") = 0 Then If InStr(.Cells(i, "D"), "ア(半角)") = 0 and .Cells(i,"D")<>"" Then MsgBox i & "行目" Cells(i, 2).Offset(0, -1).Value = "★" End If End If Next i End With End Sub このエクセルマクロはC列に「ア」があって、D列に「ア(半角)」の文字がない場合はメッセージというマクロなのですが、このマクロをア～ンまで同じ作業をしたいのですが、ひとまとめにマクロを組む事はできるのでしょうか？できる場合どのようにすれば良いでしょうか? 下記のようにして見たのですができませんでした。 Sub ア_Click() Dim i As Long With ActiveSheet For i = 5 To .Cells(Rows.count, "C").End(xlUp).Row If InStr(.Cells(i, "C"), "[ア-ン]") = 0 Then If InStr(.Cells(i, "D"), "[ア-ン](半角)") = 0 and .Cells(i,"D")<>"" Then MsgBox i & "行目" Cells(i, 2).Offset(0, -1).Value = "★" End If End If Next i End With End Sub

  • 以下のマクロは、一応簡単な文字チェックマクロなのですが・・・

    L列の5行目から文字の入っている最後の行の範囲で、 L列に『等』という文字が入っているセルで M列に『トウ』の文字が入っていない場合は、MsgBoxを出すというマクロです。 Private Sub 等_Click() Dim i As Long With ActiveSheet For i = 5 To .Cells(Rows.count, "L").End(xlUp).Row '『i』はD列の5行目から文字の入っている最後の行をいう(行の範囲) If InStr(.Cells(i, "L"), "等") > 0 Then If InStr(.Cells(i, "M"), "トウ") = 0 And .Cells(i, "M") <> "" Then MsgBox i & "行" End If End If Next i End With End Sub これに少し付け加えて、 L列に『等』が２回出てきたら、M列は『トウ』を２回出てこないとMsgBoxを出すようにしたいのですが、どのようにすればよいでしょうか？ 例えば L列7行目　柑橘類等や野菜類等 M列7行目　カンキツルイトイヤヤサイルイトウ ※　ひとつ目の『等』のヨミが『トイ』となっていますが、上記のマクロですと ヨミの最後の『トウ』に反応してスルーしてしまいます。 完璧なヨミチェックはマクロでは無理かと思いますが、このくらいはスルーしないマクロを何とかゲットしたいです。。。

  • 下記のマクロをもっと早くするには？

    下記のマクロは、 A列にあるURLがSSL化（https）されているかを調べるものです。 このマクロを動かすと、大体３秒に１つのURLを調べるくらいの早さです。 もっと早く調べられるようにするには、どのような記述にすればできるでしょうか？ また、エクセルの他の設定で、マクロを早くできたりしますか？ よろしくお願いいたします。 Sub SSL() Dim objHttp As Object Dim nURL As String Dim strURL As String Dim i As Long, f As String, l As String Dim Lastrow As Long, getLine As Long Set objHttp = CreateObject("WinHttp.WinHttpRequest.5.1") On Error GoTo ErrHandler 'A1から getLine = Cells(Rows.Count, 2).End(xlUp).Row Lastrow = Cells(Rows.Count, 1).End(xlUp).Row If getLine = Lastrow Then MsgBox "既に終わっているか、データがないです。", vbExclamation: Exit Sub If getLine < Lastrow And Cells(1, 2).Value <> "" Then getLine = getLine + 1 Else getLine = 1 '最初の行が1行目からの場合 End If For i = getLine To Lastrow strURL = LCase(Trim(Cells(i, 1).Value)) 'A列の登録URL strURL = Replace(strURL, "https:", "http:") If strURL Like "http*" Then objHttp.Open "GET", strURL, False objHttp.send DoEvents 'ESC割り込み可能にする With objHttp If .Status = 200 Then nURL = .Option(1) 'WinHttpRequestOption_URL f = Mid(strURL, 1, InStr(strURL, "://")) l = Mid(nURL, 1, InStr(nURL, "://")) If nURL = "" Then Cells(i, 2).Value = "no URL" ElseIf nURL <> "" Then If LCase(f) = LCase(l) Then Cells(i, 2).Value = "non SSL" Else Cells(i, 2).Value = "https" End If End If Else Cells(i, 2).Value = "Err:" & .Status End If End With End If Endline: nURL = "" strURL = "" Next i MsgBox "Finished" Exit Sub ErrHandler: If Err() <> 0 Then Cells(i, 2).Value = Err.Number 'マイナスになるのは外部エラー GoTo Endline End If End Sub

  • 下記のマクロはC列5行目から文字の

    下記のマクロはC列5行目から文字の入っている最後の行までの範囲で セル内に蜜柑や林檎、苺の文字が入っていたら同一行のA列にも蜜、林、苺 の文字を入れるというマクロなのですが・・・ たとえばC列12行目が 『蜜柑林檎苺』 となっていた場合、A列に入る言葉は『苺』となり『蜜』『林』という言葉が 消えてしまいます。 そこでこのマクロを少し改造して、 C列が『蜜柑林檎苺』や『蜜柑苺』となっている場合 A列に入る言葉は『蜜林苺』ないし『蜜苺』という風に積み重ねていくように改造はできないでしょうか？ ↓この部分を改造すればできるようになりますか？ Cells(i, 2).Offset(0, -1).Value = "蜜" Sub 蜜柑林檎苺() Dim i As Long With ActiveSheet For i = 5 To .Cells(Rows.count, "C").End(xlUp).Row If InStr(.Cells(i, "C"), "蜜柑") > 0 Then MsgBox i & "行目アウト！" Cells(i, 2).Offset(0, -1).Value = "蜜" End If If InStr(.Cells(i, "C"), "林檎") > 0 Then MsgBox i & "行目アウト！" Cells(i, 2).Offset(0, -1).Value = "林" End If If InStr(.Cells(i, "C"), "苺") > 0 Then MsgBox i & "行目アウト！" Cells(i, 2).Offset(0, -1).Value = "苺" End If Next i End With End Sub

  • 指定した範囲で0の行を削除するマクロ

    以下のコードで7列目が0の行を削除するマクロを作ったのですが、 13行目以降を削除するように指定できますでしょうか？ 1-12行は別のシートに数式を入れているため、削除したくないのですが、 うまくいきません。よろしくお願いいたします。 Sub 行削除() Dim Rw As Long Dim Cnt As Long Application.ScreenUpdating = False For Rw = Cells(Rows.Count, 7).End(xlUp).Row To 1 Step -1 With Cells(Rw, 7) If .Value = 0 Then .EntireRow.Delete Cnt = Cnt + 1 End If End With Next If Cnt = 0 Then MsgBox "削除対象行は、見つかりません。", vbExclamation Else MsgBox Cnt & " 件見つかり行を削除しました。", vbInformation End If End Sub

  • エクセル 2010 マクロ 検索

    http://okwave.jp/qa/q8562170.html 上記質問に追加です。 ※1 'D,E,F,G,H,I,K を検索してD,E,F,G,H,I に検索対象があった時 E,F,G,H,Iのいずれかだったら左横列の上に向かって (EならD　、FならE ・・・という具合に) 何か入力されているセルのM列の191000####をmsgboxで表示させたいです。 (画 F11セル(A-1)が検索ヒットした場合E9セル(R-01)を辿り、 その行のM列のセル(191000####)をmsgboxで表示 ※2 但し、検索結果がD列のデータだった時、その行のM列が191000####だった場合 M列の191000####をmsgboxで表示させたいです。 (画 D25セル(Y-1)対象の時) ※3 また、検索結果がD列のデータだった時、その行のM列が191000####以外だった場合 (空白だったり191000####以外の場合) M列の一番上の191000####をmsgboxで 191000####&「これは例外です」と表示させたいです。 (画 D24セル (X-1)対象の時) 現在のコードは下記のとおりです。 Sheet1に Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Address <> "$A$3" Then Exit Sub Call 検索 Range("A1:A2").Clear Range("A1").Activate End Sub 標準モジュールに Sub 検索() 　Dim Ws1 As Worksheet, Ws2 As Worksheet 　Dim strKey As Variant 　Dim s As String 　Dim c As Range, bln As Boolean 　Dim rng1 As Range 　Dim cnt As Long 　 　Set Ws1 = Sheet1 　Set Ws2 = Sheet2 　 　Ws1.Select 　 　With Ws2 　　strKey = Application.Transpose(.Range("A1").Resize(2).Value) 　　strKey = Join(strKey, "") 　End With 　 　If Trim(strKey) = "" Then MsgBox "検索キーが空です", vbCritical: Exit Sub 　 　 　With Ws1 　　Set rng1 = .Range("K2", .Cells(Rows.Count, "K").End(xlUp)) 　　For Each c In rng1.Offset(, -10) 　　　 'D,E,F,G,H,I,Kを検索 　　　s = c.Offset(0, 3).Value & c.Offset(0, 4).Value & c.Offset(0, 5).Value & c.Offset(0, 6).Value & c.Offset(0, 7).Value & c.Offset(0, 8).Value & c.Offset(0, 10).Value & 　　　 　　　If StrComp(s, strKey, vbTextCompare) = 0 And c.Offset(0, 2).Value = "" Then 　　　　c.End(xlToRight).Activate c.Offset(0, 2).Value = Date 　　　　 　　　　c.Resize(1, 14).Interior.ColorIndex = 6 　　　　bln = True 　　　　Exit For 　　　End If 　　Next c 　　 　　If Not bln Then 　　　Ws2.Select 　　　MsgBox "リストに存在しません", vbExclamation, "NotFound" 　　Else '加える 　　　Call ReSearch(Ws1.Range("M2"), c.Row) 　　　'再設定 　　　Set rng1 = .Range("K6", .Cells(Rows.Count, "K").End(xlUp)) 　　　MsgBox "残り" & DoubleCountBlank(rng1.Offset(, -8), rng1) & "品目です。", vbInformation 　　End If 　End With 　Application.Goto Ws2.Range("A1"), True End Sub Sub ReSearch(Rng As Range, j As Long) '最初のセル, 終わりの行数 Dim i As Long Dim Ws As Worksheet With Rng.Parent For i = j To Rng.Row Step -1 If CStr(.Cells(i, Rng.Column).Value) Like "191000####" Then MsgBox "指図番号 " & vbCrLf & CStr(.Cells(i, Rng.Column).Value) & " の部品です" Exit For End If Next i End With End Sub Function DoubleCountBlank(rng1 As Range, rng2 As Range) '横並びのセルのブランクをカウントする (セル範囲1 , セル範囲2) 　Dim i As Long 　Dim cnt As Long 　For i = 1 To rng1.Rows.Count 　　If VarType(rng2.Cells(i, 1)) = vbDouble Then 　　　If rng1.Cells(i, 1).Value = "" And rng2.Cells(i, 1).Value <> 0 Then 　　　　cnt = cnt + 1 　　　End If 　　End If 　Next i 　DoubleCountBlank = cnt End Function 宜しくお願い致します。

  • 【Excelマクロ】もっと頭の良い書き方って無いかな？

    5行空白列があったらそこで処理を終わりたいんですが、もっといい書き方はないでしょうか？ 下記が私の考えた頭の悪いやり方です。 Sub macro() Dim i As Integer For i = 1 To 1000 If Cells(i, 1) = "" Then 　If Cells(i + 1, 1) = "" Then 　　If Cells(i + 2, 1) = "" Then 　　　If Cells(i + 3, 1) = "" Then 　　　　If Cells(i + 4, 1) = "" Then 　　　　　If Cells(i + 5, 1) = "" Then 　　　　　　MsgBox (i - 1 & "行目で終わりです") 　　　　　　Exit For 　　　　　End If 　　　　End If 　　　End If 　　End If 　End If End If Next End Sub

  • エクセル　マクロ　抽出

    教えてください。 ○と記入されたセルを参照して、一つ上のセル・A列にある同じ行のセル・ 9行目にある同じ列のセルを抽出しようとしています。 下記の通り入力すると　行数＝値.Rowでエラーが出たしまいました。 試行錯誤頑張りましたが解決できそうにありませんのでお力を貸して頂けないでしょうか。 Sub 抽出() Dim i, 行数, 列数 As Long Dim 値 As Range i = 0 行数 = 値.Row 列数 = 値.Column For Each 値 In Sheets("sheet1").Range("C12:R171") If 値.Value = "○" Then i = i + 1 With Sheets("sheet2") .Cells(i, 3).Value = Sheets("sheet1").Cells(行数, 1).Value .Cells(i, 4).Value = Sheets("sheet1").Cells(9, 列数).Value .Cells(i, 5).Value = 値.Offset(-1, 0).Value End With End If Next End Sub

  • msgboxの表示

    Ａ列の値とC列の値をMsgboxに表示するにはどうしたらいいのでしょうか？C列で一番高い商品とその品名A列を表示させたいのですが・・ Sub hinmei() Dim i As Long For i = 2 To Range("C65535").End(xlUp).Row Dim x As Long Dim a As Long x = Cells(i + 1, 5) If Cells(i, 5).Value < x Then a = x End If Next MsgBox a End Sub

  • マクロ　検索範囲を修正したい　1つ置きのセルで

    前に以下のマクロをここで教えていただきました。このときはB列からF列の範囲でお願いしたのですが、F列～AG列の1つ置きのセル（G、I、K・・・列）で検索したいです。どう修正したらよいですか？初心者なので調べても分からなかったので教えてください。 Sub Sample1() 'この行から Dim i As Long, j As Long, vL vL = InputBox("検索値を入力してください。") Application.ScreenUpdating = False Cells.Interior.ColorIndex = xlNone For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row For j = 2 To 5 With Cells(i, j) If .Value <> "" And .Value >= vL - 3 And .Value <= vL + 3 Then .Interior.ColorIndex = 36 End If End With Next j Next i Application.ScreenUpdating = True End Sub 'この行まで

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する