VBAについて教えてください。
- VBAとは、Visual Basic for Applicationsの略で、Microsoft Office製品（特にExcel）のマクロやカスタマイズを行うためのプログラミング言語です。
- 質問内容は、エクセルに入力された日付を特定の形式に変換するVBAの実装方法に関するものです。
- 質問者は、特定のセル範囲以外のセルも変換させるための方法について教えてほしいとしています。
- ベストアンサー
ＶBAについて教えてください。
過去のQNo.457545であったのですが エクセルに20080801と入力すると 自動的に平成２０年８月１日と表示されるVBAについて 下記の構文で可能ということでした。 この場合、変換がされるのは A1からA10までのセルだと思うのですが 加えてC1からC10も変換させるには どこかに入力を加えることで 可能になるでしょうか？ よろしくお願いします。 QNo.457545にあった構文です。 Sheet1のコードウインドウに貼り付け ↓ Const HenkanAdr = "A1:A10" 'この範囲で機能する。変更して下さい Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim txt As String Application.EnableEvents = False On Error GoTo ErrorHandler If Target.Count = 1 Then If Not Intersect(Target, Range(HenkanAdr)) Is Nothing Then txt = Right("00000000" & Target.Text, 8) txt = Left(txt, 4) & "/" & Mid(txt, 5, 2) & "/" & Right(txt, 2) Target = Format(txt, "gggee年mm月dd日") End If End If Application.EnableEvents = True Exit Sub ErrorHandler: Application.EnableEvents = True End Sub
- creopatra
- お礼率96% (75/78)
- オフィス系ソフト
- 回答数1
- ありがとう数1
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
うーん。 Const HenkanAdr = "A1:A10" 'この範囲で機能する。変更して下さい とあるが、意味がわかりませんか。 Const HenkanAdr = "A1:A10,C1:C10" とでもしたらと思うが。
関連するQ&A
- ２つのVBAを組み合わせる方法
お世話になります、２つのVBAを組み合わせる方法で迷っています。 １つ目が Private Sub Worksheet_Change(ByVal Target As Range) Dim i As Long, k As Long, myNum As Long If Intersect(Target, Range("C1,B9:B39")) Is Nothing Or Target.Count > 1 Then Exit Sub Application.EnableEvents = False With Target If .Column = 3 Then myNum = WorksheetFunction.Max(Range("B9:B39")) If IsDate(.Value) Then For i = 9 To 39 If Cells(i, "A").Value = "" Then Cells(i, "B").Value = "" Else Cells(i, "B") = myNum + i - 8 End If Next i End If Else i = .Row If .Value = "" Then Range(Cells(i + 1, "B"), Cells(39, "B")).ClearContents Else For k = i + 1 To 39 If Cells(k, "A").Value = "" Then Cells(k, "B").Value = "" Else Cells(k, "B") = Cells(k - 1, "B") + 1 End If Next k End If End If End With Application.EnableEvents = True End Sub です。 ２つめが Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = True If Intersect(Target, Range("R8:R38")) Is Nothing Then Exit Sub Application.EnableEvents = False Range(Cells(Target.Row, 18), Cells(39, 18)).Value = Target.Value Application.EnableEvents = True End Sub です。２つのPrivate Sub Worksheet_Change(ByVal Target As Range)イベントのVBAですが、どのようにして組み合わせれば良いのでしょうか？
- ベストアンサー
- Excel（エクセル）
- VBA初心者です
VBA初心者です。 同じセルに数字を入れて足し算して行きたいんですが！ 下記のVBA見つけたのですが、A1に数字を入れて答えがE1に出るんですが、同じ事を A2、A3、A4、A5答えもE2、E3......で増やしたいのですが、どうするか分かりません。 どなたか教えてください。 宜しくお願いします。 Private Sub Worksheet_Change(ByVal Target As Range) Dim inp, outp As String inp = "$A$1" outp = "E1" Application.EnableEvents = False If Target.Address = inp Then Range(outp).Value = Range(outp).Value + Target.Value If Target.Value <> "" Then ActiveCell.Offset(-1, 0).Select Else Range(outp).Value = 0 End If End If Application.EnableEvents = True End Sub
- ベストアンサー
- Visual Basic
- 【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
- ベストアンサー
- オフィス系ソフト
- excel 2007 VBA コードの記述
Excel 2007 を使用しています。 TEST.xlsm というブック内に テスト01 というシートを作成し、そのタブを右クリックして コードの表示 を選択。 表示されたVBAコード入力シートに下記のコードを記述して使用してます。 Private Sub Worksheet_Change(ByVal Target As Range) 'この行から If Intersect(Target, Range("E3:E33,G3:G33,AH3:AH33,AJ3:AJ33,BK3:BK33,BM3:BM33")) Is Nothing Or Selection.Count <> 1 Then Exit Sub Application.EnableEvents = False If Target <> "" Then If IsNumeric(Target) Then Target = Target - 23 End If End If Application.EnableEvents = True End Sub 'この行まで この条件に新たに下記のコードを追加したいと思い ネット検索しながらあれこれ試行錯誤してますが まだまだVBA初心者のため上手く機能してくれません。 ※上のコードだけなら思った通りに機能します。 Private Sub Worksheet_Change(ByVal Target As Range) 'この行から If Intersect(Target, Range("Y3:Y33,BB3:BB33,CE3:CE33")) Is Nothing Or Selection.Count <> 1 Then Exit Sub Application.EnableEvents = False If Target <> "" Then If IsNumeric(Target) Then Target = Target - 30 End If End If Application.EnableEvents = True End Sub 'この行まで どなたかこれら二種のコードを一つにまとめた記述方法を 教えて頂けますでしょうか？
- ベストアンサー
- Excel（エクセル）
- エクセル マクロ 初心者です
エクセルマクロ初心者です。 以下の２つの Private Sub Worksheet_Change(ByVal Target As Range)を１つのシートで実行させたいのですが、 当方、初心者なので組み合わせ方が分かりません。 よろしくお願いします。 ===No1=== Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False Target = StrConv(Target, vbUpperCase) Application.EnableEvents = True End Sub ===No2=== Private Sub Worksheet_Change(ByVal Target As Range) Dim Ans As Integer If Target.Count = 1 Then Ans = MsgBox("コピーは禁止!!", vbCritical) MsgBox "データを消去します。" With Application .EnableEvents = False .Undo .EnableEvents = True End With End If If Target.Count = 1 Then Exit Sub Else MsgBox “複数セルのコピー禁止！" With Application .EnableEvents = False .Undo .EnableEvents = True 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 としたっ場合全く式になっていません どのようにすればよいのでしょう？
- ベストアンサー
- オフィス系ソフト
- excel2007 VBで
下記のマクロ作成して実際にセルにＡ、あるいは何かデータを入力しても下記イベント？が発生している気配がありません。 Application.EnableEvents = Falseの行がなにか問題なのでしょうか。実プログラムは If Target.Value = "Ａ" Or Target.Value = "A" Thenの他にＢ、Ｃ、計算も含んでいるのですがApplication.EnableEvents = TrueはEnd Subの前行に入れてあります。 他に設定することがあるのでしょうか。どなたか教えてください。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub '複数セルの入力は無視 Application.EnableEvents = False '割込み停止 ’[B3] = 123 ’Stop If Target.Value = "Ａ" Or Target.Value = "A" Then Target.Value = "A" End If Application.EnableEvents = True '割込み再開 End Sub excel2007 ＶＢ６．５です。
- ベストアンサー
- その他MS Office製品
- またまた エクセルのユーザー定義で
前回以下のようなコードを教えていただきましたが、この変換を複数列で使えるようにするにはどうしたらいいのでしょうか？ D,G,N,Q,X,AA,の列に効かせたいのですが。 Private Sub worksheet_change(ByVal Target As Range) If Intersect(Target, Columns(1)) Is Nothing Or Selection.Count <> 1 Then Exit Sub Dim str As String str = Target Application.EnableEvents = False If Target <> "" Then If Len(str) = 7 Then Target = Left(str, 5) & "A" & Mid(str, 6, 1) & "-" & Right(str, 1) Else Target = Left(str, 5) & "A" & Mid(str, 6, 2) & "-" & Right(str, 1) End If End If Application.EnableEvents = True End Sub
- ベストアンサー
- 会計ソフト
- VBA 範囲選択時エラー
Private Sub Worksheet_SelectionChangeのVBAでA列B列C列でワンクリックで文字が入力できるように設定致しました。 その後、A列からC列を範囲選択してDeleteするとデバック 「実行時エラー 型が一致しません」と出てしまいます。業務上、そのセルのデータは一気に消したいので困っております。どなたか分かる方よろしくお願い致します。 Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim rng As Range, rng_1 As Range, rng_2 As Range Application.EnableEvents = False Set rng_1 = Range("H17:H100") Set rng_2 = Range("I17:I100") Set rng_3 = Range("J17:J100") Set rng_4 = Range("K17:K100") Application.EnableEvents = True Set rng = Intersect(Target, rng_1) If Not rng Is Nothing Then Cancel = True If Target.Value = "" Then Target.Value = "(1)" Else Target.Value = "(1)" End If Else Set rng = Intersect(Target, rng_2) If Not rng Is Nothing Then Cancel = True If Target.Value = "(2)" Then Target.Value = Empty Else Target.Value = "(2)" End If Else Set rng = Intersect(Target, rng_3) If Not rng Is Nothing Then Cancel = True If Target.Value = "(3)" Then Target.Value = Empty Else Target.Value = "(3)" End If Else Set rng = Intersect(Target, rng_4) If Not rng Is Nothing Then Cancel = True If Target.Value = "(4)" Then Target.Value = Empty Else Target.Value = "(4)" End If End If End If End If End If End Sub
- 締切済み
- Visual Basic
- VBAの日付チェックでオーバーフローを回避したい。
VBAの日付チェックでオーバーフローを回避したい。 ExcelのＧ列のセルに入力されたものが日付型であるかどうかのチェックかけたいと思います。 以下のコードだと、数字2958466以上の入力でオーバーフローが発生します。 これを回避する方法はありますか？ セルを日付型に設定しているため、2958465（2999/12/31）までしか判別できないのでしょうが、 利用者が2958466以上を入力してしまう可能性はあります。 オーバーフローではなく、エラーメッセージが出せたら・・・と思います。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 8 Then Application.EnableEvents = False If Target <> "" And Not IsDate(Target) Then MsgBox "日付型で入力してください。" & vbCrLf & "(例:2010/10/31)", vbCritical, "入力エラー" Target = "" Target.Select End If Application.EnableEvents = True End If End Sub こんなコードも試しましたが、結果は同じでした。 ↓ Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 8 Then Application.EnableEvents = False If Target > 2958466 Then MsgBox "日付型で入力してください。" & vbCrLf & "(例:2010/10/31)", vbCritical, "入力エラー" Target = "" Target.Select Else If Target <> "" And Not IsDate(Target) Then MsgBox "日付型で入力してください。" & vbCrLf & "(例:2010/10/31)", vbCritical, "入力エラー" Target = "" Target.Select End If End If Application.EnableEvents = True End If End Sub On Error Resume Next や On Error GoTo ... での対処も考えましたが、同じ結果でした。 何か良い方法がありましたら、お願いいたします。
- ベストアンサー
- オフィス系ソフト
お礼
説明不足ですみません。 過去の記入をそのまま移してしまっていました。。。 でも教えていただいたとおりやると希望のものができました。 ありがとうございました。