• 締切済み

マクロ コピー＆ペーストで書式が変わる

特定列のセルに入力があれば、文字数で書式を変更するコードを書きました。 リストから選択や手入力なら問題ないですが、コピー＆ペーストだと、うまくいきません。 ペーストでも問題なく起動するコードはありますか？ 【やりたい事】 特定の文字を入力→〇文字未満なら折り返し解除、縮小して全体表示、文字大きさ11。〇文字以上なら折り返して文字大きさ7で表示。 【現状】 コピー＆ペーストだと、ペーストだと、文字フォント7で縮小して全体表示になってしまう。 コード Private Sub Worksheet_Change(Byval Target As Range) If Not Intersect(Target, Range(”AE:AE”)) Is Nothing Then If Len(Target.Value) < 8 Then Target.WrapText = False Target.ShrinkToFit = True Target.Font.Size = 11 ElseIf Len(Target.Value) >= 8 Then Target.WrapText = True Target.ShrinkToFit = False Target.Font.Size = 7 Else Exit Sub End If ElseIf Not Intersect(Target, Range(”AI:AI”)) Is Nothing Then If Len(Target.Value) < 5 Then Target.WrapText = False Target.ShrinkToFit = True Target.Font.Size = 11 ElseIf Len(Target.Value) >= 5 Then Target.WrapText = True Target.ShrinkToFit = False Target.Font.Size = 7 Else Exit Sub End If End Sub

みんなの回答

  • kkkkkm
  • ベストアンサー率65% (1618/2457)
回答No.1

コピペしても文字フォント7で縮小にはなりませんよ。 コードの最後に End If がもう一個無いとエラーです。

satoimogozen
質問者

補足

申し訳ない、End If貼り付け漏れてました！ あと、自己解決してしまいました。 Target.Valueってのが問題が起きてたようで、それを辞めて、 頭に Dim i As String Dim j As Long i = Cells(Target.Row, Target.Column).Value j = Len(i) で、if文のとこを、j < 8 then みたくしたら問題なくなりました！ お騒がせしました！

  1. カテゴリ
  2. パソコン・スマートフォン
  3. ソフトウェア
  4. Excel（エクセル）

関連するQ&A

  • このマクロあっていますでしょうか？よろしくお願いいたします。

    ★sheetＡ Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address <> "$C$14" And Target.Address <> "$C$19" _ And Target.Address <> "$F$19" Then Exit Sub If Target.Address <> "$R$14" And Target.Address <> "$S$14" _ And Target.Address <> "$T$19" Then Exit Sub Application.EnableEvents = False With Sheets("Ｂ") .Range("F14").Value = Range("C14").Value .Range("F17").Value = Range("C19").Value .Range("F20").Value = Range("F14").Value .Range("F23").Value = Range("F19").Value End With With Sheets("Ｃ") .Range("F13").Value = Range("R14").Value .Range("F14").Value = Range("S14").Value .Range("F18").Value = Range("T19").Value End With Application.EnableEvents = True End Sub ★sheetＢ Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address <> "$F$14" And Target.Address <> "$F$17" _ And Target.Address <> "$F$23" Then Exit Sub Application.EnableEvents = False With Sheets("Ａ") .Range("C14").Value = Range("F14").Value .Range("C19").Value = Range("F17").Value .Range("F19").Value = Range("F23").Value End With Application.EnableEvents = True End Sub ★sheetＣ Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address <> "$F$13" And Target.Address <> "$F$14" _ And Target.Address <> "$F$18" Then Exit Sub Application.EnableEvents = False With Sheets("Ａ") .Range("R14").Value = Range("F13").Value .Range("S14").Value = Range("F14").Value .Range("T19").Value = Range("F18").Value End With Application.EnableEvents = True End Sub

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

    お世話になります。 下記コードで、セルごとにクリアをすると、エラーなくうごくのですが、セルをまとめてセルを消すと実行時エラー13型が一致しません。とでてIf Target.Value = "" Thenがだめだよとでてしまいます。 どなたか、回避の方法をご教授ください。 宜しくお願いいたします。 Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("B2:E2,G2:J2")) Is Nothing Then Exit Sub If Target.Value = "" Then Exit Sub x = Target.Value With Application .ScreenUpdating = False .EnableEvents = False .Undo 'Range("B2").Value = x + Z Z = Target.Offset(1, 0).Value y = Target.Value Target.Value = x + y .EnableEvents = True .ScreenUpdating = True End With Target.Offset(1, 0).Value = x + Z End Sub

  • セルの時間入力について

    以下のコードで 00：00と入力すると最初は入力でいますが、 2回目の入力から、ユーザー定義でもhh:mmなのにセルが空になります。 数字が入ると問題有りません。 式の値（関数の入力）は00：00：00となっています。 どうか教えていただけませんでしょうか。 よろしくお願い致します。 Private Sub Worksheet_Change(ByVal Target As Range) 'この行から If Intersect(Target, Columns("L:M")) Is Nothing Or Selection.Count <> 1 _ Or Not IsNumeric(Target) Then Exit Sub If Target <= 2359 And Target Mod 100 < 60 Then Application.EnableEvents = False ' ' Debug.Print "Target.Address:" & Target.Address ' Debug.Print "Target.Address:" & Target.AddIndent With Target If Len(Target) = 4 Then Debug.Print "Len(Target) = 4" Debug.Print "Target:" & Target Debug.Print "Len(Target):" & Len(Target) .Value = Left(Target, 2) & ":" & Right(Target, 2) ElseIf Len(Target) = 3 Then Debug.Print "Len(Target) = 3" Debug.Print "Target:" & Target Debug.Print "Len(Target):" & Len(Target) .Value = "0" & Left(Target, 1) & ":" & Right(Target, 2) ElseIf Len(Target) = 2 Then Debug.Print "Len(Target) = 2" Debug.Print "Target:" & Target Debug.Print "Len(Target):" & Len(Target) .Value = "00:" & Right(Target, 2) ElseIf Len(Target) = 1 And Target = 0 Then Debug.Print "Len(Target) = 1 And Target=0" Debug.Print "Target:" & Target Debug.Print "Len(Target):" & Len(Target) .Value = "00:00" .Select ElseIf Len(Target) = 1 Then Debug.Print "Len(Target) = 1" Debug.Print "Target:" & Target Debug.Print "Len(Target):" & Len(Target) .Value = "00:0" & Right(Target, 1) End If .NumberFormatLocal = "hh:mm" End With Application.EnableEvents = True Else ' MsgBox "入力値が不正です。" With Target .Value = "" .Select End With Exit Sub End If End Sub 'この行まで

  • セル解除後、各行に値をコピーし結合するマクロ

    A1からC3のセルが結合しており、 そのセル結合を解除すると、A列のみ値がコピーされる。 コピーした後、各行ごとにセルを結合していく…… という処理をしたいと思い、 調べて下記のマクロまでなんとかこぎつけました。 Sub セル結合() Dim date1 As Variant Dim range1 As Range Application.DisplayAlerts = False For Each range1 In Selection.Rows If range1(1).MergeCells = False Then range1(1).Merge Else date1 = Selection.Rows(1).Value With range1 .UnMerge .WrapText = False .ShrinkToFit = False Selection.Value = date1 End With End If Next range1 End Sub ※実行範囲に関しては、 　任意選択をした範囲にしたいため、 　range(1)にて処理を行いました。 困っているのは、上記のマクロを実行すると、 最初の行のみ結合できないということ。 もうひとつが、 セル結合をしない時に値を左端にコピーすると、 文字が自動縮小されてしまいます。 縮小しないようにするには、 どのような処理を入れたら良いでしょうか？ お力添え頂けますと幸いです。 よろしくおねがいします。

  • マクロの追加をお願いしたいですm(_ _)m

    以前こちらで教えていただきましたマクロを使用していまして、要改善点が２つほど見つかりましたので、どなたかご教授いただけないでしょうか？ 現在使用しているマクロと改善希望点を以下に記載しますので、宜しくお願いします。 １．カナが含まれるセルに対して反応させたいです。 ２．コマンドボタンを使用して、特定のセルに対して、反応させることは出来ますでしょうか？ 以下、現使用マクロです。 Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False With Target セルの内容 = Replace(.Value, "　", "", 1, -1, vbTextCompare) 'すべて全角文字で　数字を含まない場合　名前　とみなす If Not セルの内容 Like "*#*" And 0 < Len(セルの内容) And _ セルの内容 = StrConv(セルの内容, vbUpperCase Or vbNarrow) And _ セルの内容 = StrConv(セルの内容, vbLowerCase Or vbWide) Then '実際に私が行いたいこと・・「 "さま"を付けて」 敬称 = "さま" .Value = .Value & 敬称 If 30 < .Font.Size Then 'セルのフォントサイズより２０下のサイズ .Characters(Start:=Len(.Value) - Len(敬称) + 1, _ Length:=Len(敬称)).Font.Size = .Font.Size - 20 Else 'セルのフォントサイズの70% .Characters(Start:=Len(.Value) - Len(敬称) + 1, _ Length:=Len(敬称)).Font.Size = Int(.Font.Size * 0.7) + 1 End If End If End With Application.EnableEvents = True End Sub 以上、宜しくお願い致します。

  • VBAで特定の文字に赤色を追加

    いつもお世話になります。 WINDOWS XP EXCELL2003 です。 「公　、有」という２文字に赤色の文字を条件書式で対応しようとしましたがすでに３通りを 設定しているため下記のマクロで、 If Target.Value = 5 Then Target.Value = "有" If Target.Value = 6 Then Target.Value = "公" 　の２つの文字のみに赤色のフォントにするための記述を追加したいのですが お知恵を拝借できませんか。 ご指導よろしくお願いします。 ご参考に現在使用のマクロです。 Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("I13:AM27")) Is Nothing Then Exit Sub Application.EnableEvents = False If Target.Value = 0 Then Target.Value = Empty If Target.Value = 1 Then Target.Value = "日" If Target.Value = 2 Then Target.Value = "△" If Target.Value = 3 Then Target.Value = "▼" If Target.Value = 4 Then Target.Value = "夜" If Target.Value = 5 Then Target.Value = "有" If Target.Value = 6 Then Target.Value = "公" Application.EnableEvents = True End Sub

  • エクセル　ダブルクリックで処理日の入力

    お世話になります。 先般、お教え頂きました別のダブルクリックイベントプロシージャと 下記の当日の日付を入力するという処理を同じシート上で行いたいのですが、ＶＢエディターにどのように記述したら良いかわかりません。 当方、かなりの初心者です。 よろしくご教授くださいませ。 【新しく加えたい処理】 Option Explicit Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Intersect(Target, Range("b4:C999")) Is Nothing Then Exit Sub If ActiveCell = "" Then ActiveCell = Date Cancel = True End If End Sub 【もともと使っている処理】 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Not Intersect(Target, Range("h1:h999")) Is Nothing Then With Target If .Value = "" Then .Value = "有" ElseIf .Value = "有" Then .Value = "無" ElseIf .Value = "無" Then .Value = "" End If End With ElseIf Not Intersect(Target, Range("i1:i999")) Is Nothing Then With Target If .Value = "" Then .Value = "要" ElseIf .Value = "要" Then .Value = "不要" ElseIf .Value = "不要" Then .Value = "" End If End With End If End Sub よろしくお願いします。

  • エクセル　ＶＢＡマクロ if文　はどうすれば？

    先ほど質問したのですが、さらにわからなくなったのでお願いします 先ほどの質問 ～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～ http://okwave.jp/qa/q7236338.html >変数と式の両立は難しいでしょうからどうすればよいのでしょう？ 　⇒関数では出来無いのはエクセルの常識ですのでマクロ（ＶＢＡ）組込みになります。 一例です。 対象シートタブ上で右クリック→コードの表示→以下のコード貼り付けてA1に枚数を入力して お試しください。 サンプルコード Private Sub Worksheet_Change(ByVal Target As Range) 単価 = 5 If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub If IsNumeric(Target.Value) And Target.Value > 0 Then 　Application.EnableEvents = False 　Target.Value = Target.Value * 単価 　Application.EnableEvents = True End If End Sub ～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～ ↓変更＆応用したのですが、、、、 ＥＸ：（セル）　　 　セル番号　　用紙種類１～３　　　　　　　用紙種類 　　　C12　　　Ａ３モノクロ１　　　　　D12　　Ａ３カラー１ 　　　C13　　　Ａ３モノクロ２　　　　　D13　　Ａ３カラー２ 　　　C14　　　Ａ３モノクロ３　　　　　D14　　Ａ３カラー３ ※金額の違いは、モノクロとカラーの値段が違うだけ 　１～３は金額的な違いはない とあった場合、 ためしに先ほどのを応用して用いたのですが 変更点は、用紙サイズ、カラーの有無による金額 　　　　　　　出力先セルの番号 Private Sub Worksheet_Change(ByVal Target As Range) を Private Sub A4_mono_1(ByVal Target As Range) Private Sub A4_mono_2(ByVal Target As Range) ・　 　　　　　　　　　　　・ 　　　　　　　　　　　・ と変更したのですがうまく動作しなかったのですが、 どういった点が悪かったのでしょうか？ ～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～ 最終的な質問↓ 上記のものはＶＢＡマクロ文は基本１つのみなので、if文で作らなくてはいけないということが分かったのですが、そこでさらに疑問が浮かびました、 Private Sub Worksheet_Change(ByVal Target As Range) If or(target.columns = C12:C14) Then 単価1 = 7.6 If Intersect(Target, Range("C12:C14")) Is Nothing Then Exit Sub If IsNumeric(Target.Value) And Target.Value > 0 Then Application.EnableEvents = False Target.Value = Target.Value * 単価1 Application.EnableEvents = True単価1 = 7.6 elseif or(target.columns = D12:D14) Then 単価2 = 30.6 If Intersect(Target, Range("D12:D14")) Is Nothing Then Exit Sub If IsNumeric(Target.Value) And Target.Value > 0 Then Application.EnableEvents = False Target.Value = Target.Value * 単価2 Application.EnableEvents = True End If End Sub としたっ場合全く式になっていません どのようにすればよいのでしょう？

  • エクセル　マクロ　追加

    Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Count > 1 Then Exit Sub End If If Not Intersect(Target, Range("B1:C15")) Is Nothing And Target.Value = "" Then Exit Sub End If Dim c As Worksheet Dim flag As Boolean flag = False For Each c In Worksheets If c.Name = Target.Value Then flag = True Next If flag = False Then Exit Sub If Target.Address = "$C$2" Or Target.Address = "$C$3" Or Target.Address = "$C$4" _ Or Target.Address = "$C$5" Or Target.Address = "$C$6" Or Target.Address = "$C$7" _ Or Target.Address = "$C$8" Or Target.Address = "$C$9" Or Target.Address = "$C$10" _ Or Target.Address = "$C$11" Or Target.Address = "$C$12" Or Target.Address = "$C$13" _ Or Target.Address = "$C$14" Or Target.Address = "$C$15" Then Worksheets(Target.Value).Visible = True Worksheets(Target.Value).Select Else End If End Sub セルに文字が打っています シート名とセルが一緒の文字のとき移動するマクロです データがあるセルをクリックするとそのデータ先に飛ぶように 設定したマクロなのですが、 選択するページの文字は全部最初から設定されている黒文字がつかわれているのですが データがあるときは文字の色を変化させたいのですが どうすればいいでしょうか？

  • 【ExcelVBA】 既にあるマクロの間で実行させたいのです。

    こんにちは 下のマクロを・・・ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Const RangeName As String = "●入力" If Not Intersect(Range(RangeName), Target) Is Nothing Then Cancel = True If Target = "●" Then Target = "" Else Target = "●" End If End If End Sub このマクロの■ここで実行■で実行させたいのですが、どのようにしたらよいでしょう。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Address <> "$D$1" Then Exit Sub Cancel = True Columns("A:U").Select Range("T1").Activate Selection.Sort Key1:=Range("D2"), Order1:=xlAscending, Header:=xlYes, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _ :=xlPinYin, DataOption1:=xlSortNormal Selection.Replace What:="ああ", Replacement:="", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Range("D1").Select End Sub ■ここで実行■ Private Sub Worksheet_Change(ByVal Target As Range) strAddress = "A1:A2000" On Error GoTo ErrorHandler If Target.Count > 1 Then GoTo ErrorHandler If Not Intersect(Target, Range(strAddress)) Is Nothing Then Application.EnableEvents = False Range(strAddress).ClearContents Target.Value = "●" End If ErrorHandler: Application.EnableEvents = True End Sub

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

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

質問する