• 締切済み

Excelのマクロに関して

Excelのマクロで特定のセルに特定の数値が入力されている場合、違うセルにある文字列を入力させる場合 すいません。 説明がものすごく悪くて申し訳ないのですが。 A列(行は100くらいまで)に「100」の数値が入力されている場合に、同じ行のE列に文字列「○○」を返す場合は どのようなマクロを使ったらよろしいですか。 会社の人が Sub TimeIntervalPaint() Dim x As Integer, op As Integer Dim TI As Range Application.ScreenUpdating = False Cells.Interior.ColorIndex = xlNone op = Range("B3").End(xlDown).Row Range("E3:BF" & op).ClearContents Call WorkTime For x = 3 To 150 If Range("A" & x).Value = "101" Then If TI Is Nothing Then Set TI = Union(Range("L" & x), Range("AD" & x), Range("T" & x, "W" & x)) Else Set TI = Union(TI, Range("L" & x), Range("AD" & x), Range("T" & x, "W" & x)) End If こういったマクロを登録しているのですが、新たにE列に文字列を入力できるように改良したいのです。 既に退職していて聞くことすら出来ません。 説明がものすごく悪いのは分かっていますが、どなたかご教授ください。

みんなの回答

noname#69779
noname#69779
回答No.2

間違えてました。 End sub　の前に下記があると思います。 Application.ScreenUpdating = True ここの手前に下の7行追加でＯＫでしょう。 Columns("E:E").NumberFormatLocal = "@" aa% = 3 Dim bb As String Do Until aa% = 150 Range("E" & aa%) = Range("A" & aa%).Text aa% = aa% + 1 Loop

noname#69779
noname#69779
回答No.1

これに変更してみてください。 End Sub の前に最後の7行を追加でどうでしょう。 Sub TimeIntervalPaint() Dim x As Integer, op As Integer Dim TI As Range Application.ScreenUpdating = False Cells.Interior.ColorIndex = xlNone op = Range("B3").End(xlDown).Row Range("E3:BF" & op).ClearContents Call WorkTime For x = 3 To 150 If Range("A" & x).Value = "101" Then If TI Is Nothing Then Set TI = Union(Range("L" & x), Range("AD" & x), Range("T" & x, "W" & x)) Else Set TI = Union(TI, Range("L" & x), Range("AD" & x), Range("T" & x, "W" & x)) End If Columns("E:E").NumberFormatLocal = "@" aa% = 3 Dim bb As String Do Until aa% = 101 Range("E" & aa%) = Range("A" & aa%).Text aa% = aa% + 1 Loop

  1. カテゴリ
  2. パソコン・スマートフォン
  3. Windows
  4. その他(Windows)

関連するQ&A

  • 公差を設定して判定するマクロ

    規格を設けて判定するマクロについて教えてください。 下記のようなマクロがあるとき、現在はE列、H列、K列が同じ数値の場合は 塗りつぶしが行われるようになっています。 これを少し改造して、B4セルに公差の数値を入力した時 E列の数値を基準とし、H列、K列がE列からB4セルに入力した公差内なら色を付けるような マクロを組みたいです。 例えばB4セルに2と入力してあるとします。 E列の数値が4.2だとした場合 H列は2.2、K列は6.2ならE列の数値の±2なので塗りつぶしされる。 E列の数値にB4セルの入力した数値の±をH列、K列を超える場合は 塗りつぶしは行わない、という感じです。 わかりずらい説明で申し訳ありませんが、宜しくお願いします。 Sub 判定仮() Dim i As Integer, j As Integer Range(Cells(3, "L"), Cells(32, "L")).ClearContents Range(Cells(3, "E"), Cells(32, "K")).Interior.ColorIndex = 0 For i = 3 To 32 If WorksheetFunction.CountIf(Rows(i), Cells(i, "E")) > 2 Then If Cells(i, "E").Row Mod 2 = 1 Then Union(Cells(i, "E"), Cells(i, "H"), Cells(i, "K")).Interior.ColorIndex = 6 Cells(i, "L") = "OK" Else If Cells(i, "E").Row Mod 2 = 0 Then Union(Cells(i, "E"), Cells(i, "H"), Cells(i, "K")).Interior.ColorIndex = 40 Cells(i, "L") = "OK" End If End If End If Next If WorksheetFunction.CountIf(Range("L3:L32"), "OK") > 29 Then MsgBox "データチェックOK(^O^)b" End If End Sub

  • エクセルマクロで教えてください

    マクロ初心者です。アドバイスをお願いします。以下のマクロですとB列の100行目までの塗りつぶしのセルのカウントは出来るのですが、シート上の全てをカウントしたいのです。１TO 100の100の部分をどう変更したら良いのか教えてください。 Sub セルの色数1() Dim I As Integer Dim Count As Integer Count = 0 For I = 1 To 100 If Cells(I, 2).Interior.ColorIndex <> xlNone Then Count = Count + 1 Next I Range("C1").Value = Count End Sub

  • 公差を設定して判定するマクロの続き

    質問No.9150010の続きです。 上記の質問で下記のようなご回答を頂きました。 E列の数値に対してB４セルに入力されている公差の数値に H列とK列の数値が入っているか調べるマクロです。 下記のマクロで完璧に行えるようになりましたが もしE列の数値に対して、公差内に入っていない数値がH列とK列にあった場合 その公差内に入っていないセルのみを赤く塗りつぶすには下記のマクロにどうのように追加すればよいでしょうか？ パターンとしてはH列もしくはK列のどちらかのみが公差内に入っていない時もあれば 両方とも公差内に入っていない場合もあります。 Sub 判定仮本物() Dim i As Integer, j As Integer Dim k As Double Range(Cells(3, "L"), Cells(32, "L")).ClearContents Range(Cells(3, "E"), Cells(32, "K")).Interior.ColorIndex = 0 k = Cells(4, 2) 'B4セルの値 For i = 3 To 32 If Abs(Cells(i, "E") - Cells(i, "H")) <= k And Abs(Cells(i, "E") - Cells(i, "K")) <= k Then If i Mod 2 = 1 Then Union(Cells(i, "E"), Cells(i, "H"), Cells(i, "K")).Interior.ColorIndex = 6 Cells(i, "L") = "OK" Else Union(Cells(i, "E"), Cells(i, "H"), Cells(i, "K")).Interior.ColorIndex = 40 Cells(i, "L") = "OK" End If End If Next If WorksheetFunction.CountIf(Range("L3:L32"), "OK") > 29 Then MsgBox "データチェックOK(^O^)b" End If End Sub

  • Excelのマクロについて

    文字列から数値だけを抽出するマクロを見つけたのですが、抽出するデータを選択してから実行しなければなりませんでした。 抽出するデータはAセル以下にしかないので、データを選択しないでも実行できるようにするにはどうしたら良いのでしょうか？ 宜しくお願いします。 以下見つけたマクロです。 　Sub test() 　Dim mydata As String 　Dim c As Range 　Dim i As Integer 　For Each c In Selection 　 mydata = "" 　For i = 1 To Len(c) 　 If Mid(c, i, 1) >= 0 And Mid(c, i, 1) <= 9 Then 　 mydata = mydata & Mid(c, i, 1) 　 　End If 　 Next 　 c.Offset(0, 1) = mydata 　 Next 　End Sub

  • エクセルのマクロ

    Sub test() Dim x As Range 　For Each x In Selection 　　　If x.Value <> "●" And Selection.Font.ColorIndex = 0 Then 　　　x.Value = "○" 　End If Next End Sub 上記は、選択されているセルのフォントが黒でかつ"●"が入力されていない場合は"○"を入力する、というマクロですがうまく動作しません。どうすれば正常に動作するようになるでしょうか？

  • エクセルマクロvbのchangeイベントで複数入力した時フリーズして困っています

    マクロ初心者で困っています。 セルに『新規』と入力すると、Ｔ２セルに『Ｆ』と表示されるようにしたのですが、 『新規』をコピーして複数セルに貼り付けると貼り付けた状態のままパソコンが動かなくなってしまいます。 複数のセルがchangeした場合、マクロを終了する方法はないでしょうか？ 教えて下さいm(_ _)m Private Sub Worksheet_Change(ByVal Target As Range) Dim tr As Integer Dim x As String If Intersect(Target, Range("H4:H253")) Is Nothing Then Exit Sub x = Target.Value tr = Target.Row If x = "" Then Exit Sub If x = "新規" Then Range("T2") = "F" 　 End sub

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

    お手数ですが誰か教えてください！ BのデーターをAに集計するマクロを作ったのですが 処理速度とっても遅いのです。 高速で処理する方法はありませんでしょうか？ 私が作ったマクロ Sub 集計() Dim Z As Integer Dim i As Integer Dim X As Integer For Z = 2 To 2000 For i = 2 To 2000 For X = 3 To 20 If Worksheets("A").cells(Z, 1) = Worksheets("B").cells(i, 1) And 　　　　　　Worksheets("A").cells(1, X) = Worksheets("B").cells(i, 14) Then Worksheets("A").cells(Z, X) = Worksheets("B").cells(i, 16) End If Next X Next i Next Z End Sub 　　　　　　どこかが間違っている気がしますがマクロ初心者のため 　　　　　　先に進めません。 　　　　　　どうかご教授よろしくお願い致します。

  • エクセルマクロ　特定の文字入力の際の処理(2)

    お世話になります。 以前、下記質問をし、締め切ったのですが、もう一点、教えていただきたい点がありました。 質問 エクセルマクロで、sheet1のE列の6～30行に指定する文字が入力された際、 B列のその同じ行にある文字を取得し、その取得した文字をsheet3のC6から K6まで書き出していきたいのですが、どのようにしたらよいでしょうか？ ご回答 Private Sub Worksheet_Change(ByVal Target As Range) 　　Dim i As Long 　　Dim r As Range 　　Const 指定文字 As String = "X" 　　Set r = Range("E6:E30") 　　If Target.Count > 1 Then Exit Sub 　　If Intersect(r, Target) Is Nothing Then 　　　　Exit Sub 　　End If 　　If Target.Value <> 指定文字 Then 　　　　Exit Sub 　　Else 　　　　'大文字小文字を区別する場合 　　　　i = ActiveSheet.Evaluate( _ 　　　　　　"SumProduct(EXACT(" & r.Address & ",""" & 指定文字 & """)*1)") 　　　　'大文字小文字を区別しない場合 　　　　i = WorksheetFunction.CountIf(r, 指定文字) 　　　　 　　　　Application.EnableEvents = False 　　　　Worksheets("Sheet3").Cells(6, i + 2) = _ 　　　　　　Target.Offset(, -3) 　　　　Application.EnableEvents = True 　　End If End Sub このご回答を、 取得した文字をsheet3のC6からK6までに4列毎に書き出して いく場合にはコードをどのようにしていけば良いのでしょうか。 C6→H6→M6→・・・ すみません、再度お願い致します。

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

    よろしくおねがいします 各々のシートのＸ１セルを値を参照して ゼロ以外の時は 印刷の処理をして ゼロの時は処理をしない という内容を書きたく思います。 このままで記述だとＸ１セルの値がゼロの場合 いきなりsubを抜けてしまうのですが １，２枚目でゼロの場合 その次のシートにきちんと処理が 継続したいのですが どこを修正したらよろしいでしょうか？ Sub マクロ() Dim shAry As Variant Dim i As Integer, cnt As Integer, x As Integer shAry = Array("東京", "千葉", "群馬") For cnt = LBound(shAry) To UBound(shAry) Sheets(shAry(cnt)).Select x = Int(((Range("x1").Value) - 1) / 5) + 1 If x = 0 Then GoTo ゼロの場合の処理 Else MsgBox "印刷枚数は " & x & "枚です" ここにいんさつの処理があります End If Next Exit Sub ゼロの場合の処理: MsgBox "印刷する内容はありません" End Sub

  • エクセルマクロに関する質問

    最近、エクセルマクロを始めてたのですが、下記のような状態で困っています。 プログラムを実行した際に、Cells((I1 + I5), I6)のセルに計算式がはいって欲しいのですが、 現状では計算結果が入るだけになってしまっています。 また、単純に文字列に変換してしまうだけだと、変数が邪魔になって式になってくれません。 誰かお分かりになる方がいましたら、教えてください。 　Dim I1 As Integer Dim I2 As Integer Dim I3 As Integer Dim I4 As Integer Dim I5 As Integer Dim I6 As Integer Dim I7 As Integer Dim I8 As Integer Cells((I1 + I5), I6) = Cells((I1 + I5) - 2, I6) + Cells((I1 + I5), I6 - 2) - Cells(I1 + I5, I6 - 1)

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

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

質問する