- ベストアンサー
業界でのコード記述時の常識？
empty_blueの回答
過去形ですが仕事で使ってました 日常的にVBA＝仕事として考えるなら IF END IFは毎回書きます。 タブで下すのは、随時です。 面倒くさいならIDEとかエディターでどうにかできないか考えます
関連するQ&A
- 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（エクセル）
- セルが何行なのかをVBAで取得したい
セルが何行なのかをVBAで取得したいのですが どういうコードにすればいいですか？ 例えば、Ａ１セルに a b c と入ってる場合、３行ですが それをVBAで取得するにはどうすればいいですか？ Sub test() Dim r As Range Set r = Cells(1, 1) If r.Value Like "*" & Chr(10) & "*" Then MsgBox "改行があります" End If End Sub というコードで改行が有ることは取得できたのですが 何行かまでは取得する方法がわかりません。
- ベストアンサー
- Excel（エクセル）
- 【VBA】改行されたセルの条件
VBAにてA1のセルが画像のように改行されたセルであっても条件式で処理を行うようにしたいのですがうまくできません。 ↓式のように作成はしてみました どうしたら改行されたセルでも処理が行えるのでしょうか？ Sub test() If Range("A1") = (行1行2の場合) Then 処理 End If End Sub
- ベストアンサー
- Excel（エクセル）
- マクロ 記述が悪くエラーがかかります。
いつも回答ありがとうございます。 最後らへんの記述で実行時エラー【型が一致しません】がかかります。 Worksheets("集計用").Range(b1, b2).Copy _ Destination:=Worksheets(b3).Range("B2") ← ここでエラーがかかる。 ワークシート名に変数を使用しているせいだと思います。 解決する方法を御指導して頂けないでしょうか？宜しくお願い致します。 Sub グラフの作成() Dim Date1 As Date Dim Date2 As Date Dim SName As String Dim b1 As Variant Dim b2 As Variant Dim b3 As Variant Dim d1 As Variant Dim d2 As Variant Dim d3 As Variant With Worksheets("集計用") s1: Date1 = Application.InputBox("最初の日付を2012/12/1のように入力してください。") If Date1 = 0 Then MsgBox "キャンセルされました。", vbOKOnly Exit Sub End If Set b1 = .Columns("B").Find(Date1, , xlValues, 1) If b1 Is Nothing Then If MsgBox("入力した日付が見当たりません。" & vbNewLine & _ "再度入力しますか？", vbYesNo) = vbYes Then GoTo s1 Else MsgBox "処理を中止しました", vbOKOnly Exit Sub End If End If d1 = b1.Row s2: Date2 = Application.InputBox("最初の日付を2012/12/31のように入力してください。") If Date1 = 0 Then MsgBox "キャンセルされました。", vbOKOnly Exit Sub End If Set b2 = .Columns("B").Find(Date2, , xlValues, 1) If b2 Is Nothing Then If MsgBox("入力した日付が見当たりません。" & vbNewLine & _ "再度入力しますか？", vbYesNo) = vbYes Then GoTo s2 Else MsgBox "処理を中止しました", vbOKOnly Exit Sub End If End If d2 = b2.Row s3: SName = Application.InputBox("商品名を入力して下さい。") If SName = "False" Then MsgBox "キャンセルされました。", vbOKOnly Exit Sub End If Set b3 = .Rows("3").Find(SName, , xlValues, 1) If b3 Is Nothing Then If MsgBox("入力した商品名が見当たりません。" & vbNewLine & _ "再度入力しますか？", vbYesNo) = vbYes Then GoTo s3 Else MsgBox "処理を中止しました", vbOKOnly Exit Sub End If End If d3 = b3.Column End With Worksheets.Add After:=Worksheets("集計用") ActiveSheet.Name = b3 Worksheets("集計用").Range(b1, b2).Copy _ Destination:=Worksheets(b3).Range("B2") Worksheets("集計用").Range(Cells(d1, d3), Cells(d2, d3)).Copy _ Destination:=Worksheets(b3).Range("C2") End Sub
- ベストアンサー
- オフィス系ソフト
- マクロ セル参照時の記述
いつも回答ありがとうございます。 似たような質問をしていますが、下記の記述の(b3.value!"$B$1").の箇所でエラーがかかりました。 .SetSourceData Source:=Range(b3.value!"$B$1").CurrentRegion どのように変更したら上手く動作するのでしょうか？ｂ３は変数です。御指導の程宜しくお願い致します。 Sub グラフの作成() Dim Date1 As Date 'グラフの始点の日付 Dim Date2 As Date 'グラフの終点の日付 Dim SName As String '商品名 Dim b1 As Variant 'グラフの始点のセル番号 Dim b2 As Variant 'グラフの終点のセル番号 Dim b3 As Variant '対象の商品名のセル番号 Dim d1 As Variant 'b1と違う列のセル番号 Dim d2 As Variant 'b2と違う列のセル番号 Dim d3 As Variant 'b3と違う列のセル番号 With Worksheets("集計用") s1: Date1 = Application.InputBox("最初の日付を2012/12/1のように入力してください。") If Date1 = 0 Then MsgBox "キャンセルされました。", vbOKOnly Exit Sub End If Set b1 = .Columns("B").Find(Date1, , xlValues, 1) If b1 Is Nothing Then If MsgBox("入力した日付が見当たりません。" & vbNewLine & _ "再度入力しますか？", vbYesNo) = vbYes Then GoTo s1 Else MsgBox "処理を中止しました", vbOKOnly Exit Sub End If End If d1 = b1.Row s2: Date2 = Application.InputBox("最初の日付を2012/12/31のように入力してください。") If Date1 = 0 Then MsgBox "キャンセルされました。", vbOKOnly Exit Sub End If Set b2 = .Columns("B").Find(Date2, , xlValues, 1) If b2 Is Nothing Then If MsgBox("入力した日付が見当たりません。" & vbNewLine & _ "再度入力しますか？", vbYesNo) = vbYes Then GoTo s2 Else MsgBox "処理を中止しました", vbOKOnly Exit Sub End If End If d2 = b2.Row s3: SName = Application.InputBox("商品名を入力して下さい。") If SName = "False" Then MsgBox "キャンセルされました。", vbOKOnly Exit Sub End If Set b3 = .Rows("3").Find(SName, , xlValues, 1) If b3 Is Nothing Then If MsgBox("入力した商品名が見当たりません。" & vbNewLine & _ "再度入力しますか？", vbYesNo) = vbYes Then GoTo s3 Else MsgBox "処理を中止しました", vbOKOnly Exit Sub End If End If d3 = b3.Column Worksheets.Add After:=Worksheets("集計用") ActiveSheet.Name = b3.Value .Activate .Range(b1, b2).Copy _ Destination:=Worksheets(b3.Value).Range("B2") .Activate .Range(Cells(d1, d3), Cells(d2, d3)).Copy _ Destination:=Worksheets(b3.Value).Range("C2") With Worksheets(b3.Value).Range("D2:D" & Range("C65536").End(xlUp).Row) .Formula = "=SUM(C2,D1)" .Value = .Value End With End With Charts.Add With ActiveChart .ChartType = xlColumnClustered .SetSourceData Source:=Range(b3.value!$B$1").CurrentRegion With .Axes(xlValue) .MaximumScale = 10 .MajorUnit = 1 End With .Location Where:=xlLocationAsObject, Name:=b3.Value End With End Sub
- ベストアンサー
- オフィス系ソフト
- エクセルのマクロで改行挿入(Excel2002)
セルの文字列に全角10文字(半角20文字)ごとに Chr(10) で改行を入れたいです。 全角10文字を越えてはダメ。 選択したセルに動作する物です。 - - - - - Sub 半角20改行_Click() Dim Tmp As Range, Cha As Long, Num As Long Dim STR As String, MdTmp As Variant, flg As Boolean For Each Tmp In Selection For Cha = 1 To Len(Tmp.Value) MdTmp = Mid(Tmp.Value, Cha, 1) If MdTmp = vbLf Then If flg = False Then STR = STR & MdTmp Num = 0 GoTo NextRow End If If LenB(StrConv(MdTmp, 128)) = 1 Then Num = Num + 1 Else Num = Num + 2 End If ' この↓(20)で改行文字数変更 If Num >= 20 - 1 Then STR = STR & MdTmp & vbLf flg = True Num = 0 Else STR = STR & MdTmp flg = False End If NextRow: Next Tmp.Value = STR STR = "" Num = 0 Next For Each Tmp In Selection If Right(Tmp, 1) = Chr(10) Then Tmp.Value = LeftB(Tmp, LenB(Tmp) - 2) End If Next End Sub - - - - - - これだと あいうえおかきくけこさしすせそ ↓↓ あいうえおかきくけこ ←全角10改行 さしすせそ <成功！> あいうえお(かきくけこさし)すせそ ↓↓ あいうえお(かきくけ ←全角9.5改行 こさし)すせそ <成功！> あいうえお(かきくけ)こさしすせそ ↓↓ あいうえお(かきくけ ←全角9.5改行 )こさしすせそ <失敗！！> こうなってほしい↓。 あいうえお(かきくけ) ←全角10改行 こさしすせそ 改行の狭間に全角文字が来た場合は全角9.5文字ごとに改行。 それ以外は全角10文字ごとに改行。 このようにする物を教えてください。
- ベストアンサー
- オフィス系ソフト
- これは実行中のＶＢＥコードのイミディエイトウイント
Sub Sample() Dim WD, task, n As Long Set WD = CreateObject("Word.Application") 'Wordを起動します For Each task In WD.Tasks 'Word VBAのTasks'コレクションを調べます If task.Visible = True Then ' タスク(プロセス)が実行中だったら Debug.Print task.Name ' タスクの名前を書き出します End If Next WD.Quit Set WD = Nothing End Sub これを実行すると 結果に イミディエイト も含まれるのですが、 これは実行中のＶＢＥコードのイミディエイトウインドウのことを言っているのでしょうか？
- ベストアンサー
- その他MS Office製品
- 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
- Excelの空白行を上に詰めるVBAについて
Excelにて特定の列のみの空白を上に詰めるVBAを組んだのですが、 全ての列に適用してしまって困っております。 Sub 空白を上に詰める() Dim Lrow, i As Long Dim myRange As Range Lrow = Range("AH65536").End(xlUp).Row Set myRange = Rows(Lrow + 1) For i = 1 To Lrow If Cells(i, 34) = "" Then Set myRange = Union(myRange, Rows(i)) End If Next i myRange.Delete End Sub 上記のように「AH」列にのみ適用するように組みましたが、 うまくいきません。 VBAは初心者レベルです。 VBAにお詳しい方のご意見をお聞かせ願えますでしょうか。 宜しくお願い致しますm(_ _)m
- ベストアンサー
- 財務・会計・経理
- 最後の改行を削除ことは可能ですか？
文字の最後に改行が入ってる場合のみ最後の改行を削除ことは可能ですか？ エクセルには ”いいい会社”の後ろに改行が入っています。 "ううう会社”と ”えええ会社"の間にも改行が入っていますが、これはこのままにしたいです。 一番最後の改行だけ削除する方法はありますか？ ｖｂａでも大丈夫なので教えてください。
- ベストアンサー
- Excel（エクセル）
お礼
有難う御座います。 参考になりました。