Excel VBAでの""の正しい使い方

このQ&Aのポイント
  • Excel VBAを使用して、セルY1の値に応じてセルI6とI7の書式設定を変更する方法について質問です。
  • セルY1の値が0の場合、セルI6の書式設定を「m"月"d"日("aaa") 17:00~ 艇 庫」に設定し、I7は空白にします。
  • セルY1の値が1の場合、セルI6の書式設定を「m"月"d"日("aaa") 16:00~ 艇 庫」に設定し、I7を「m"月"d"日("aaa") 17:00~ 艇 庫」に設定したいです。修正方法を教えてください。
回答を見る
  • ベストアンサー

Excel VBAでの" "の正しい使い方

Excel 2003を使っています。 セルY1には0又は1の数値が入ります。 セルI6とI7の「セルの書式設定」をY1の値によって変化させるのが目的です。 セルY1が0の場合はI6の「セルの書式設定」を「m"月"d"日("aaa") 17:00~ 艇 庫"」に、I7は空白にする。 また、セルY1が1の場合はI6の「セルの書式設定」を「m"月"d"日("aaa") 16:00~ 艇 庫"」に、 I7は「m"月"d"日("aaa") 17:00~ 艇 庫"」にしたいのです。  とりあえず、VBAで以下のようなものを作りましたが、" "の使い方が間違っているようで、意図した結果が出ません。 Private Sub Worksheet_Change(ByVal Target As Range)   If Target.Address = "$Y$1" Then      If Range("Y1") = 0 Then       Range("I6").NumberFormatLocal = "m""月""d""日(""aaa"") 17:00~ 艇 庫"       Range("I7").NumberFormatLocal = ""     Else       Range("I6").NumberFormatLocal = "m""月""d""日(""aaa"") 16:00~ 艇 庫"       Range("I7").NumberFormatLocal = "m""月""d""日(""aaa"") 17:00~ 艇 庫"     End If    End If End Sub  どのように修正すればよいか、お教えください。画像も何もなくて分かりにくいかもしれませんが、よろしくお願いします。

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

  • ベストアンサー
  • keithin
  • ベストアンサー率66% (5278/7940)
回答No.1

ツールメニューのマクロの「新しいマクロの記録」を使い、 >I6の「セルの書式設定」を「m"月"d"日("aaa") 17:00~ 艇 庫"」に という操作を実際に手で行ってマクロに録ってみれば、 Sub Macro1() ' ' Macro1 Macro ' マクロ記録日 : 2014/7/30 ユーザー名 : ' '   Selection.NumberFormatLocal = "m""月""d""日(""aaa"") 17:00~ 艇 庫""" End Sub といった具合にすればよいと、タチドコロに判ります。 何がどうならこうすればよいのかはおおまかアナタのマクロで合ってますので、そのまま流用してください。 #ただしゼロの時にI7を「空白にする」には、書式を設定するんじゃなく range("I7").clearcontents などのようにして、セルを消去します。

moodesu
質問者

お礼

早速のご教示ありがとうございました。Selectionの部分をRange("I6")に置き換えて動かしてみるとうまくいきました。感激です。「新しいマクロの記録」は浮かびませんでした。これで意図したものが出来上がりました。本当にありがとうございました。

関連するQ&A

  • エクセルVBA

    エクセル2003です 勉強中です 教えてください Sheet1     A      B      C       D      1   日付    種類    数量1    数量2  2   2月3日    C      300        10   3   2月4日     B      200       5 4   2月5日     A     100       20 5   2月3日     A     100       10 6   2月4日     B     200       5 7   2月5日     C     300       20 8   2月3日      A      300       20 9   2月4日     C      200        5 10  2月5日     B     100       10 Sheet1     F      G      H       I      1   日付    種類    数量1    数量2  2   2月3日    A      400          3   2月3日     C      300       4   2月4日     B     600       5   2月5日     A     100       6   2月5日     C     400       7 したい事 *A列~D列のデータをF列からI列へ複数条件の集計をしたいのですが *A列~D列の数値が変動すると勝手に自動で集計をして欲しい(シートがアクティブでなくても) *下記コードでC列までの集計ができますがD列の集計がわかりません  (増やそうとすると頭の中がぐちゃぐちゃになって・・・) *前回の集計が残ってしまう Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim myDic As Object, myKey, myItem Dim myVal, myVal2, myVal3 Dim i As Long Range("F2", Range("I" & Rows.Count).End(xlUp)).ClearContents Range("F1:I1").Value = Range("A1:D1").Value Set myDic = CreateObject("Scripting.Dictionary") ' データを配列に格納 myVal = Range("A2", Range("A" & Rows.Count).End(xlUp)).Resize(, 4).Value ' myDicへデータを格納 For i = 1 To UBound(myVal, 1) myVal2 = myVal(i, 1) & "_" & myVal(i, 2) If Not myVal2 = "_" Then If Not myDic.exists(myVal2) Then myDic.Add myVal2, myVal(i, 3) Else myDic(myVal2) = myDic(myVal2) + myVal(i, 3) End If End If Next 'Key,Itemの書き出し myKey = myDic.keys myItem = myDic.items For i = 0 To UBound(myKey) myVal3 = Split(myKey(i), "_") Cells(i + 2, 6).Value = myVal3(0) Cells(i + 2, 7).Value = myVal3(1) Cells(i + 2, 8).Value = myItem(i) Next Set myDic = Nothing '並べ替え Range("F2", Range("H" & Rows.Count).End(xlUp)).Sort _ Key1:=Range("F2"), Order1:=xlAscending, _ Key2:=Range("G2"), Order2:=xlAscending, _ Header:=xlGuess End Sub 頭のなかがこんがらがってしまいます お願いです 出来れば説明付きで教えていただけませんか よろしくお願いします

  • エクセルVBAを教えて下さい

    エクセルの表で -AB C D E F 1年月--1801 2------ 3------ 4------ (-)は空欄でセルE1=18、F1=1とします。 コントロールボックスをつかって Private Sub Command登録_Click() Dim d1 As Long Dim d2 As Long Dim ret As Variant Dim FindValue As String Dim TotalAddress As String If Range("E1").Value = "" Or Range("F1").Value = "" Then MsgBox "該当する場所にデータが入っていません。", vbCritical Exit Sub End If d1 = Range("A65536").End(xlUp).Offset(1).Row d2 = Range("B65536").End(xlUp).Offset(1).Row FindValue = """" & Range("E1").Value & Range("F1").Value & """" TotalAddress = Range("A1").Resize(d1).Address & "&" & Range("B1").Resize(d1).Address ret = Evaluate("MATCH(" & FindValue & "," & TotalAddress & ",0)") If IsError(ret) Then Cells(d1, 1) = Range("E1").Value Cells(d2, 2) = Range("F1").Value Else MsgBox "既に同じ組み合せがあります。", vbInformation End If End Sub というものを作ったのですが、E1=18、F1=1及びコマンドボタンを別シートに作成し、上記の表への登録をできるようにしたいのですが、なにかいい方法はありませんか?

  • エクセル2007のVBAでオートフィルタのチェック

     エクセル2007のVBAでオートフィルタのチェックを特定の日付のみに入れたいのです。 (同様の質問をしておりますが、質問の意図が伝わらなかった、意味不明だったのか、ご検討中なのか、こちらで再度質問させて頂きます。)  ユーザー設定フィルタでは視覚的に解りつらい為、フィルタの▽をクリックした時に、チェックがされている事を確認したいのです。 【シート1の内容】 セルA1から行方向に数字の1~4 セルB1から行方向に、日付、値1、値2、% ’日付は過去1年~未来1年分です。 セルA3から列方向に、書式は yyyy/m/d セルB3とC3から列方向に、ランダムな整数 セルD3から列方向に、“=B3/C3”が入力されており、書式は パーセンテージ(小数点以下の桁数は“1”) セルF2に 2012(年)、セルG2に 9(月)、セルH2に 閾値として 10.5% 【目的】 動きとしては、過去1年前~2012年9月末日までのデータの内、閾値以上の結果を出すつもりで書きました。 【質問】 フィルタがかかった▽をクリックした時に、指定した範囲の日付チェックボックスにチェックを入れたいのです。 試行錯誤の状態のコードで失礼します。 Selection.AutoFilter Field:=1, Criteria1:=Array("日付"), Operator:=xlFilterValues, _ Criteria2:=Array(buf) この部分のbufの記述方法が、わかりません。 Sub Sample1() Dim TargetDate As Date Dim YY As Integer Dim MM As Integer Dim DD As Date Dim EoD As Integer Dim MaxRow As Integer Dim i As Integer Dim buf As Variant Selection.AutoFilter YY = ActiveSheet.Range("F2").Value MM = ActiveSheet.Range("G2").Value DD = YY & "/" & MM & "/1" EoD = Day(DateAdd("d", -1, DateAdd("m", 1, DD))) MaxRow = Range("A1").End(xlDown).Row TargetDate = YY & "/" & MM & "/" & EoD 'TargetDate = Format(YY & "/" & MM & "/" & EoD, "m/d") 'TargetDate = DateValue(YY & "/" & MM & "/" & EoD) 'MsgBox TargetDate For i = 3 To MaxRow With Worksheets("Sheet1").Cells(i, 4) .Activate .FormulaR1C1 = "=R[-0]C[-2]/R[-0]C[-1]" .Style = "Percent" .NumberFormatLocal = "0.0%" End With Next i buf = "" For d = 0 To 365 ' If d = 0 Then ' buf = "2, " & """" & TargetDate - d & """" ' ElseIf d >= 1 Then ' buf = buf & ", 2, " & """" & TargetDate - d & """" ' End If ' If d = 0 Then ' buf = "2, " & """" & Format(TargetDate - d, "m/d/yyyy") & """" ' ElseIf d >= 1 Then ' buf = buf & ", 2, " & """" & Format(TargetDate - d, "m/d/yyyy") & """" ' End If 'buf = buf & " 2, " & """" & Format(TargetDate - d, "yyyy/m/d") & """" 'buf = buf & " 2, " & """" & DateValue(TargetDate - d) & """" 'buf = buf & "2, " & """" & DateValue(TargetDate - d) & """" 'If d <> 365 Then ' buf = buf & """" & DateValue(TargetDate - d) & """" & ", " 'Else ' buf = buf & """" & DateValue(TargetDate - d) & """" 'End If If d <> 365 Then buf = buf & """" & TargetDate - d & """" & ", " Else buf = buf & """" & TargetDate - d & """" End If 'Range("N1") = buf Next d Range("A1").Select Selection.AutoFilter Selection.AutoFilter Field:=1, Criteria1:=Array("日付"), Operator:=xlFilterValues, _ Criteria2:=Array(buf)   'ここでエラーを検出してます。 'Criteria2:=Array(2, "2012/3/5", 2, "2012/08/11", 2, "2014/5/6") End Sub 皆様、良いお知恵をお貸し下さい。。。 OSは、WinXPとWin7共動いて欲しいです。 宜しくお願い致します。

  • エクセルVBA全シートに差し込みマクロ構文

    Sheets("震圧データ").Select MsgBox "新規ブックに年月分けて" & vbCrLf & "震圧データを転記します、" & vbCrLf & "お待ちください。" Dim c As Range Dim i As Integer Dim LastRow As Long Dim NewSheetName As String, MatchFlag As Boolean Application.ScreenUpdating = False Workbooks.Add With ThisWorkbook.Sheets("震圧データ") For Each c In .Range(.Cells(4, "A"), .Cells(Rows.Count, "A").End(xlUp)) If NewSheetName <> Year(c.Value2) & "年" & Month(c.Value2) & "月" Then NewSheetName = Year(c.Value2) & "年" & Month(c.Value2) & "月" If c.Row - 2 > Sheets.Count Then Worksheets.Add after:=Worksheets(Worksheets.Count) Else Sheets(c.Row - 2).Select End If ActiveSheet.Name = NewSheetName Sheets(NewSheetName).Range("A1").Value = "年月日" Sheets(NewSheetName).Range("B1").Value = "曜日" Sheets(NewSheetName).Range("C1").Value = "A" Sheets(NewSheetName).Range("D1").Value = "B" Sheets(NewSheetName).Range("E1").Value = "C" Sheets(NewSheetName).Range("F1").Value = "時間" Sheets(NewSheetName).Range("G1").Value = "状態" Sheets(NewSheetName).Range("I1").Value = "No.1" Sheets(NewSheetName).Range("I2").Value = "記録者" Sheets(NewSheetName).Range("I3").Value = "氏名:" Sheets(NewSheetName).Range("I4").Value = "=IF(ISBLANK(A4),"""",DATEDIF("""",Today(),""Y"") & ""歳"")" Sheets(NewSheetName).Range("I5").Value = "=""転載日""" Sheets(NewSheetName).Range("I6").Value = "=TODAY()" Sheets(NewSheetName).Range("I56").Value = "=IF(ISBLANK(A56),"""",""No.2"")" Sheets(NewSheetName).Range("I57").Value = "=IF(ISBLANK(A56),"""",""記録者"")" Sheets(NewSheetName).Range("I58").Value = "=IF(ISBLANK(A56),"""", ""氏名:"")" Sheets(NewSheetName).Range("I59").Value = "=IF(ISBLANK(A56),"""",DATEDIF("""",Today(),""Y"") & ""歳"")" Sheets(NewSheetName).Range("I60").Value = "=IF(ISBLANK(A56),"""",""転載日"")" Sheets(NewSheetName).Range("I61").Value = "=IF(ISBLANK(A56),"""",TODAY())" Sheets(NewSheetName).Range("I111").Value = "=IF(ISBLANK(A111),"""",""No.3"")" Sheets(NewSheetName).Range("I112").Value = "=IF(ISBLANK(A111),"""",""記録者"")" Sheets(NewSheetName).Range("I113").Value = "=IF(ISBLANK(A111),"""", ""氏名:"")" Sheets(NewSheetName).Range("I114").Value = "=IF(ISBLANK(A111),"""",DATEDIF("""",Today(),""Y"") & ""歳"")" Sheets(NewSheetName).Range("I115").Value = "=IF(ISBLANK(A111),"""",""転載日"")" Sheets(NewSheetName).Range("I116").Value = "=IF(ISBLANK(A111),"""",TODAY())" Sheets(NewSheetName).Range("I166").Value = "=IF(ISBLANK(A166),"""",""No.4"")" Sheets(NewSheetName).Range("I167").Value = "=IF(ISBLANK(A166),"""",""記録者"")" Sheets(NewSheetName).Range("I168").Value = "=IF(ISBLANK(A166),"""", ""氏名"")" Sheets(NewSheetName).Range("I169").Value = "=IF(ISBLANK(A166),"""",DATEDIF("""",Today(),""Y"") & ""歳"")" Sheets(NewSheetName).Range("I170").Value = "=IF(ISBLANK(A166),"""",""転載日"")" Sheets(NewSheetName).Range("I171").Value = "=IF(ISBLANK(A166),"""",TODAY())" Sheets(NewSheetName).Range("H1").Value = "提出済○" Sheets(NewSheetName).Range("A57").Select Range("I6,I61,I116").Select Range("I6,I61,I116,I171").Select Selection.NumberFormatLocal = "yyyy/m/d" Columns("F:F").Select Selection.NumberFormatLocal = "[$-409]h:mm AM/PM;@" Range("G1").Select With Selection .HorizontalAlignment = xlCenter End With LastRow = Sheets(NewSheetName).Cells(Rows.Count, "A").End(xlUp).Row Sheets(NewSheetName).Cells(LastRow + 1, "A").Resize(1, 8).Value = .Cells(c.Row, "A").Resize(1, 8).Value Sheets(NewSheetName).Columns("A:I").EntireColumn.AutoFit Next 新規ブック最終シートのみ適用できますが他の月別シートに適用できておりません '↓どのような構文にしたら適用されるのでしょうか?ここからが質問です↓ If Sheets(NewSheetName).Range("A56") = "" Then Range("I56:I171").Delete Else Sheets(NewSheetName).Range("A56").Value = "年月日" Sheets(NewSheetName).Range("B56").Value = "曜日" Sheets(NewSheetName).Range("C56").Value = "A" Sheets(NewSheetName).Range("D56").Value = "B" Sheets(NewSheetName).Range("E56").Value = "C" Sheets(NewSheetName).Range("F56").Value = "時間" Sheets(NewSheetName).Range("G56").Value = "状態" End If 'ここまで! どなたかご教示お願いします .Activate End With

  • EXCEL VBAの配列でわかりません。

    こんなコードがあるのですが、最後の他のシート(作業中シート)に書き込もうとするとエラーになってしまいます。”Sheets("作業中").”を抜くと同じシートに結果は返ってくるのですが…。コードの内容は、ある範囲のある列から空白ではないセルを探し出してその行のデータを配列で汲み取り、他のシートに一括で洗い出すというものです。 Sub 作業中() Dim myRow As Long Dim Data As Variant Dim WC() As Variant Dim WCE() As Variant myRow = Range("H1").CurrentRegion.Rows.Count Data = Range("H1:M" & myRow).Value For i = 1 To myRow If Data(i, 5) <> "" Then a = a + 1 Else b = b + 1 End If Next ReDim WC(a) ReDim WCE(b) c = 0 d = 0 For i = 1 To myRow If Data(i, 5) <> "" Then WC(c) = Range("H" & i & ":K" & i).Value c = c + 1 Else WCE(d) = Range(Cells(i, 8), Cells(i, 11)).Value d = d + 1 End If Next For i = 0 To a Range(Cells(i + 1, 15), Cells(i + 1, 18)).Value = WC(i) Next For i = 0 To b Range(Cells(i + 1, 19), Cells(i + 1, 22)).Value = WCE(i) Next e = Range(Cells(1, 15), Cells(a, 18)).Value Sheets("作業中").Range(Cells(1, 1), Cells(a, 4)).Value = e End Sub ちなみに同じシートから↓のコードを実行するとうまくいきます。 なぜ~??わからな~い??おしえてくださーい!! Sub test() Dim a As Variant a = Range("H1:K4") Sheets("作業中").Range("N1:Q4") = a End Sub

  • excel vbaについてです

    VBA初心者で、暇な時にいろいろためしています。 以下のマクロを組んだのですが、エラーがでてうまくいきません。 どこがいけないのかご指摘願います。 Sub ather() Dim A As Range Dim B As Range Dim i As Integer With ThisWorkbook.Worksheets("Sheet1") For i = 1 To 30 Set A = Cells(i, 1) Set B = Cells(1, i) If Not .Range(A).Interior.ColorIndex = vbYellow Then GoTo port10 If Not .Range(B).Interior.ColorIndex = vbRed Then GoTo port10 .Range(B).Offset(, 1).Value = "○" port10: Next i End With End Sub イメージとしてはセルの塗りつぶしが黄色で、かつ右隣のセルの塗りつぶしが赤の時に、 赤色セルの右隣のセルに○を表示させようとしているのですが。。。 こうしたらいいんじゃない?といったアドバイスもお願いします(-人-)

  • エクセルVBAのイベントで質問です。

    ある範囲のセルの色をダブルクリックにより変えていますが、 下の("D5:D50,F5:F50,K5:K50,M5:M50"))の範囲を例えばSheet1の A2以下に始めの範囲、B2以下に終りの範囲を下に書いていって、 対象とする範囲を可変にしたいのですが、どのようにすれば いいでしょうか。 例えば("D5:D50,F5:F50,K5:K50,M5:M50"))であれば A2に「D5」 B2に「D50」 A3に「F5」 B3に「F50」 などとセルにセル番地をいれておいて、コードを変えなくても シート上で範囲を変えていけるようにできないでしょうか。 やり方があれば教えてください。 よろしくお願いします。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim r As Range Set r = Intersect(Target, Range("D5:D50,F5:F50,K5:K50,M5:M50")) If r Is Nothing Then Exit Sub With r.Interior If .ColorIndex = xlNone Then .ColorIndex = 3 ElseIf .ColorIndex = 3 Then .ColorIndex = 4 ElseIf .ColorIndex = 4 Then .ColorIndex = xlNone End If End With Cancel = True End Sub

  • エクセルVBAを修正したい

    数字を入力すると記号に変換になるマクロを 元ファイルを修正して作成したいのですが、 同一シートにC9:M33,C9:Y25,O27:Y29といった 範囲の異なる表がある場合はセル範囲をどのように記述すれば良いでしょうか? StartCol = 4 '開始列 EndCol = 20 '終了列 BlankCount = 0 I = 16 '開始行 L = 14 '行の指定 Do While Len(Range("B" & CStr(I)) & Range("C" & CStr(I))) > 0 For J = StartCol To EndCol If Len(ActiveSheet.Cells(L, J).Value & ActiveSheet.Cells(L + 1,J).Value) > 0 Then tmp = "" If ActiveSheet.Cells(I, J).Value = "×" Or ActiveSheet.Cells(I,J).Value = "中止" Then Else If Len(ActiveSheet.Cells(I, J).Value) = 0 Then K = -1 Else K = ActiveSheet.Cells(I, J).Value End If Select Case K Case 0 tmp = "×" Case 1 To 14 tmp = "△" Case Is >= 15 tmp = "○" End Select End If Next I = I + 1 If Len(Range("B" & CStr(I)) & Range("C" & CStr(I))) = 0 Then L = I + 1 I = I + 3 End If Loop End Sub

  • Excel簡単入力

       A     B     C     D 1  日付   部門   支店    氏名   金額 2  21/12/1  製造   東京    山田   1000 3  21/12/3  営業   大阪    宮崎    500 上セルと同一内容を簡単に入力する際、Ctrl キー+Shift+"で上セルの内容をコピーし編集状態になりEnterで確定しますよね?それをもっと簡単に空白セルの時Enterで上セルをコピーし編集状態でもう一度Enterで確定というマクロを組みたいので教えてください。初心者です。 なお、皆さんに教えてもらってA1:A600まで以下のマクロを設定し正常に動作しています。 Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next Dim r As Range Dim flg As Long flg = 0 If Intersect(Target, Range("A4:A600")) Is Nothing Then Exit Sub 'A列のみを対象 最初につなげるところ ActiveSheet.Unprotect flg = 1 For Each r In Target Dim a As Long Dim b As String With r If Not .NumberFormatLocal = "ge.m.d" Or .Value = "" Then .NumberFormatLocal = "G/標準" 'セルの書式設定がH00.m.d形式だったら標準に戻す 'セルが 数字    且      整数    且  101以上  且    991231以下 の場合 If IsNumeric(.Value) And Int(.Value) = .Value And .Value >= 101 And .Value <= 1111231 Then b = Str(Val(Left(.Value, 2)) + 1988) & "/" & Mid(.Value, 3, 2) & "/" & Right(.Value, 2) If IsDate(b) Then 'もしbがDateの形なら .Value = CDate(b) 'データ型を日付にする 'ここにつなげる。 変数はtmpからbに直す .NumberFormatLocal = "ggg" & _ IIf(Format(b, "e") > 9, "e年", "_0e年") & _ IIf(Month(b) > 9, "m月", "_1m月") & _ IIf(Day(b) > 9, "d日", "_1d日") ActiveSheet.Protect End If End If End With Next End Sub どうかよろしくお願いします。

  • Excel VBAで、様々な書式設定のセルをyyyymmddの文字列に

    Excel VBAで、様々な書式設定のセルをyyyymmddの文字列にしたい dim i Columns("A:B").NumberFormatLocal = "@" For i = 1 To 5 If Cells(i, 1)NumberFormat = "@" Then Cells(i, 2) = Aells(i, 1).text Else Cells(i, 2) = Application.text(cells(i, "1"), "yyyymmdd") End If Next Excel VBAで、様々な書式設定のセルをyyyymmddの文字列にしたいのですが・・ 上記のソースを書いた場合、文字列・日付・ユーザ定義などの書式設定ではうまくいきますが、標準で19990101などと入力されていた場合はエラーになってしまいます。 どのように直せばうまくいくのでしょうか? よろしくお願いします。

専門家に質問してみよう