• ベストアンサー

Excel2003 VBA　ある列の範囲選択（？）

お世話になります。 表題の件で ご相談が御座います。 以前 こちらで「入力された（貼り付けにも対応）数字でもアルファベットでも全角半角問わずに全部半角にする」 という強烈なコードをご教示いただいて便利に使わせていただいていたのですが 自分が余計なお願いをしてしまい（「対象の列を全部」と言ってしまいました） なので全65000行を確認しているのか（？）処理スピードが遅くなってしまいました。。。 ご教示いただいたコードは下記になるのですが Private Sub Worksheet_Change(ByVal Target As Range) Select Case Target.Column Case 6, 7 Target.Value = StrConv(Target.Value, vbNarrow) End Select End Sub その中で「Case 6, 7」この部分を「F7:F500,G7:G500」このようにしたいと思い 「Range」を付けて「Range("F7:F500", "G7:G500")」としてみましたが 実行時エラー（？）が発生してしまうようで上手く動作してくれません。。。 どのように書き換えたら「F7:F500,G7:G500」この部分だけに反映されるようになるのでしょか？ どなたか お分かりになる方ご教示いただけますでしょうか。 宜しくお願い致します。 ＊ちなみに余談ではありますが「Excelの行」って何で65000行もあるんでしょうね？ （65536という数がExcel的には都合がいいということは知っていますが。。） にしても普通そこまで使う前に重くなってブックを分けると思うのですが。。

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

  • ベストアンサー
  • merlionXX
  • ベストアンサー率48% (1930/4007)
回答No.4

> ちなみに入力されてるデータを「Delete」で消すと実行時エラーのようになるのは何ででしょうか？ Deleteしたのは一つのセルではなく複数のセルだったのではないですか？ 以前のご質問のとき、一つのセルを対象にするのはこれで、一定の範囲への入力にも対応するのはこっちと２つ回答しておいたと思います。 複数セルのDeleteは、まさに一定の範囲への入力と同じことなのです。 Deleteだけであれば、今度（No3）で記載したコードでエラーは出なくなります。

ookami1969
質問者

お礼

はい！ 出なくなりました！！ ありがとう御座います！！ また 困った時には 宜しくお願い致します！！

その他の回答 (3)

  • merlionXX
  • ベストアンサー率48% (1930/4007)
回答No.3

No1 merlionXXです。 はたと気づいて修正してもどったところ、すでにFEX2053さまからご指摘がありましたね。 一応貼っておきますね（エラーの場合もありえるのでエラーロジックを組み込んであります。） Private Sub Worksheet_Change(ByVal Target As Range) Select Case Target.Column Case 6, 7 If Target.Row <= 501 And Target.Row >= 7 Then Application.EnableEvents = False On Error GoTo line Target.Value = StrConv(Target.Value, vbNarrow) End If End Select line: Application.EnableEvents = True End Sub

ookami1969
質問者

お礼

完璧です！！ ありがとう御座います！！！ 断然 早くなりました！！ いつもいつもありがとう御座います！！

  • FEX2053
  • ベストアンサー率37% (7987/21354)
回答No.2

これって、どのみちワークシート全体の変化を検知して処理してるので 範囲を狭めたからと言って、処理時間は変わらないかと。むしろ、書き 換え時に無限ループに入り込んでいることの方が問題ではないかと思う んですが・・・。 とりあえず、範囲を狭める前に以下のコードを試してみてください。 Private Sub Worksheet_Change(ByVal Target As Range) Select Case Target.Column Case 6, 7 Application.EnableEvents = False Target.Value = StrConv(Target.Value, vbNarrow) Application.EnableEvents = True End Select End Sub この辺の詳細はこちらを参考にされると良いかと。 http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/vba_event.html#change Target.Addressで範囲を見ても良いんですが、結局コードが複雑になって 処理時間が延びるだけではないかと思います。

ookami1969
質問者

お礼

ご回答ありがとう御座います！ 早いです！ すぐにセルが動きます！！ ＞どのみちワークシート全体の変化を検知して処理してるので範囲を狭めたからと言って、処理時間は変わらないかと。 そうなんですか？ 範囲を狭めて その範囲だけ検索すれば処理スピードが上がるかと思ったのですが、そうではないのですね？ いただいたURLを見て 上記コードを見ると イベントを一旦 停止して 再度 開始するという事なのでしょうか。 それをやると何で処理スピードが上がるのかは理解していないのですが 早くなった事は実感出来ます！ ありがとう御座いました！！

  • merlionXX
  • ベストアンサー率48% (1930/4007)
回答No.1

こんにちは、またお会いしましたね。 前回回答した者です。 では一例です。 Private Sub Worksheet_Change(ByVal Target As Range) Select Case Target.Column Case 6, 7 If Target.Row <= 500 And Target.Row >= 7 Then Target.Value = StrConv(Target.Value, vbNarrow) End If End Select End Sub

ookami1969
質問者

お礼

おぉ！ これはこれは！ 上記コードの生みの親様ではありませんか！ 何度もありがとう御座います！ こういう時は「IF～Then」が必要なのですか。 範囲を広げたい時には どこをイジればいいのか分かりやすいです！ ありがとう御座います！ ちなみに入力されてるデータを「Delete」で消すと実行時エラーのようになるのは何ででしょうか？ もしよろしければ再度お願い致しますｍ（＿ ＿）ｍ

  1. カテゴリ
  2. パソコン・スマートフォン
  3. ソフトウェア
  4. オフィス系ソフト

関連するQ&A

  • VBA　のエラーがわかりません・・・ｗ

    Sub Worksheet_Change(ByVal Target As Range) Dim 初期値 As Integer Dim 増減値 As Integer Select Case Target.Address Case "$C$5" Select Case Target.Value Case 1 Range("C6").Value = 24 Range("D5").Value = 600 Range("D6").Value = 0 Range("E5").Value = 400 Range("E6").Value = 0 Range("B7").Value = "★1 MaxAttackPoint:700 / MaxDeffencePoint:900" Case 2 Range("C6").Value = 32 Range("D5").Value = 1000 Range("D6").Value = 0 Range("E5").Value = 500 Range("E6").Value = 0 Range("B7").Value = "★2 MaxAttackPoint:1100 / MaxDeffencePoint:1300" End Select Case "$D$5" Select Case Range("C5").Value Case 1 初期値 = 600 Case 2 初期値 = 1000 Case Else Exit Sub End Select If Target.Value < 初期値 Then 増減値 = 4 Else 増減値 = 8 Range("D6").Value = (初期値 - Target.Value) / 100 * 増減値 Case "$E$5" Select Case Range("C5").Value Case 1 初期値 = 400 Case 2 初期値 = 500 Case Else Exit Sub End Select If Target.Value < 初期値 Then 増減値 = 4 Else 増減値 = 8 Range("E6").Value = (初期値 - Target.Value) / 200 * 増減値 End Select End Sub Sub Worksheet_Change(ByVal Target As Range) Select Case Target.Address Case "$F$5" Select Case Target.Value Case "炎" Range("F6").Value = 4 Case "水" Range("F6").Value = 4 End Select 　 Case "$G$5" Select Case Target.Value Case "ドラゴン" Range("G6").Value = -8 Case "海竜" Range("G6").Value = -8 End Select Case "$H$5" Select Case Target.Value Case "ドラゴン" Range("H6").Value = -16 Case "海竜" Range("H6").Value = -16 End Select Case "$I$5" Select Case Target.Value Case "○" Range("I6").Value = 40 Case "×" Range("I6").Value = 0 End Select End Select End Sub とあるカードゲームのステータス決定を行う為に組まれたマクロです。 作成者は私だけではないのですが、もう何回もしつこく質問をしているため 気が引けてしまい、こちらで質問することにしました・・・ｗ 　 エラー内容は ２つ目のSub Worksheet_Change(ByVal Target As Range)の 「Worksheet_Change」の名称が間違っています。 という事でした。何を入れればいいのかサッパリです(；´ω) 　 エラーの改善方法について教えてください。 宜しくお願いします

  • EXCEL 異なるVBA

    教えて下さい、EXECL以下の異なるVBA (A>,B>)が２つあります、同じシートでそれぞれ動くようにさせたいです1つに合わせる事は出来ないでしょうか? 当方初心者の為わかりません教えて下さい。 A> Private Sub Worksheet_Change(ByVal Target As Excel.Range) If Target.Address(0, 0, xlA1, 0) <> "A1" Then Exit Sub With Range("F9:I9,K17:K36").Borders(xlDiagonalUp) If Left$(Target.Value, 1) = "S" Then .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic Else .LineStyle = xlNone End If End With End Sub B> Private Sub Worksheet_Change(ByVal Target As Range) With Sheet2 Select Case Target.Address Case Is = "$D$1" .Range("A1").Insert Shift:=xlDown .Range("A1").Value = Target.Value Case Is = "$D$2" .Range("B1").Insert Shift:=xlDown .Range("B1").Value = Target.Value End Select End With End Sub

  • VBA シート間の同期（列、行、選択範囲）

    初めての質問となります。 よろしくお願いいたします。 シート間の同期でセルの同期は他の質問を参照してできましたが、 ”行”や”列”での同期/相互参照は、どのように書けばいいのでしょうか。。 下記、sheet1”A1”とsheet2の”B1”に記載したcodeです。 'sheet1に以下を記述 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$A$1" Then Sheets("Sheet2").Range("$B$1").Value = Sheets("Sheet1").Range("$A$1").Value End If End Sub 'sheet2に以下を記述 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$B$1" Then Sheets("Sheet1").Range("$A$1").Value = Sheets("Sheet2").Range("$B$1").Value End If End Sub 【質問内容】 sheet1の”A列”とsheet2の”B列”はどう書くのでしょう？ 上記の方法では無理、または負荷が大きい場合は、 sheet1の”A1:C3”とsheet2の”D4:F6”はどう書くのでしょう？ という内容になります。 先日からVBAを触り始め、 自分なりに調べて一通り試してみましたが解決できませんでした。。 お手数おかけしますが何卒よろしくお願いいたします。

  • VBAで別の列のセルにも色付け～２

    WINDOWS XP EXCELL ２００３です。 いつもお世話になります。 ご迷惑とは重々と承知しながら再度質問させていただきます。 １　御指導を賜りたいのは、 現在A列には月度を示す　０１～１２　が入力され月別にセルの背景色を塗りつぶしていますがこれをA列用のマクロを工夫してF列にも同様に適用したい。 例えば参照図で言うと A７　０５　ピンク　 A８　０５　ピンク A９　０６　ライトブルー　 A１０　０７　草色　等のように ※ 参照図のF列のセルには背景色は適用していません。 ２　参照図のそれぞれの設定は、　　 ※ 計画　と　生産はセル位置だけの違いで生産の方は割愛します。 D１　ユーザー定義　mm/dd D２　ユーザー定義　２０００００ D３　数値 A７　ユーザー定義　mm マクロ ボタン「計画入力」 Sub 計画入力() Dim GYOU '追加 GYOU = Range("C65536").End(xlUp).Row + 1 Cells(GYOU, 2).Value = Range("D1").Value Cells(GYOU, 3).Value = Range("D2").Value Cells(GYOU, 4).Value = Range("D3").Value End Sub ボタン「セルセット」 Sub 計画セル() 　　 Range("D1,D2,D3,D1").Select End Sub A列のセル塗りつぶし Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row >= 8 And Target.Address = Cells(Rows.Count, "C").End(xlUp).Address Then Target.Offset(0, 0).Value = Date End If Dim c As Integer If Target.Column <> 2 Then Exit Sub If Target.Value = "" Then c = 0 Else On Error GoTo line Select Case Month(Target.Value) Case 1: c = 46 Case 2: c = 4 Case 3: c = 39 Case 4: c = 6 Case 5: c = 7 Case 6: c = 8 Case 7: c = 43 Case 8: c = 3 Case 9: c = 44 Case 10: c = 24 Case 11: c = 40 Case 12: c = 17 End Select End If Target.Offset(0, -1).Interior.ColorIndex = c Target.Offset(0, -1).Font.ColorIndex = IIf(c = 1, 2, 0) Exit Sub line: Target.Offset(0, -1).Interior.ColorIndex = 0 Target.Offset(0, -1).Font.ColorIndex = 0 End Sub 御指導よろしく御願いします。

  • VBAでセルの色付を別の列にも追加するには

    WINDOWS XP EXCELL ２００３です。 いつもお世話になります。 現在下記の如く、 A列にマクロを設定しています。 ※A F列には下記の数式が入っています。 A2 =IF(B2="","",TEXT(B2,"mm")) F2 =IF(G2="","",TEXT(G2,"mm")) Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row >= 2 And Target.Address = Cells(Rows.Count, "C").End(xlUp).Address Then Target.Offset(0, -1).Value = Date End If Dim c As Integer If Target.Column <> 2 Then Exit Sub If Target.Value = "" Then c = 0 Else On Error GoTo line Select Case Month(Target.Value) Case 1: c = 46 Case 2: c = 4 Case 3: c = 39 Case 4: c = 6 Case 5: c = 7 Case 6: c = 8 Case 7: c = 43 Case 8: c = 3 Case 9: c = 44 Case 10: c = 24 Case 11: c = 40 Case 12: c = 17 End Select End If Target.Offset(0, -1).Interior.ColorIndex = c Target.Offset(0, -1).Font.ColorIndex = IIf(c = 1, 2, 0) Exit Sub line: Target.Offset(0, -1).Interior.ColorIndex = 0 Target.Offset(0, -1).Font.ColorIndex = 0 End Sub 上記のマクロに追加でF列にも同様にセルの色付けするにはどうすればいいか ご教授を御願いできないでしょうか。

  • 離れた列をvbaで数値で選択するには？

    Sub Macro1() Range("a:c,e:g").Select End Sub を数値にしたいのですが、 Sub Macro2() Range(Columns(1), Columns(3) & ":" & Columns(5), Columns(7)).Select End Sub だと、rangeでコンパイルエラーになります。 http://okwave.jp/qa/q7329478.html を見たのですが、 どうすればいいのかわからないので教えてください。

  • エクセル　ＶＢＡ　シートの選択　

    windows XP でエクセル２０００を使っています。 Sub aaa() Sheets("Sheet1").Select Dim a As String a = Cells(2, 4) Sheets(a).Select Range("A1").Select End Sub というマクロだと　セルに入っている値のシート名を探してくれます。 ですが Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) If Intersect(Target, Range("B11:b683")) Is Nothing Then Exit Sub Worksheets("Sheet1").Range("C2").Value = Target.Value Dim b As String b = Range("C2).value （←ここをcellsにしてもダメ） Sheets(b).Select Range("A1").Select End Sub これだとsheets(b)を選びません。Sheets(b).Selectのところが黄色くなります。 何処が間違えているのでしょうか。 全くの素人ですが、仕事で必要に迫られています。 わかりやすく回答・解説くれると助かります。

  • ExcelのVBAで教えてください。

    Private Sub Worksheet_Changeについて教えて下さい。 まず初歩的なご質問ですが、Private Sub Worksheet_Changeを1つのシートモジュールに1個以上組むことは可能なのでしょうか？ 例えばネットで以下のようにsheet1に Private Sub Worksheet_Change Private Sub Worksheet_Change_1 _1を付けてるのを見たことがあったので試してみましたが動作しませんでした。 今回行いたいのは1つが、指定したセルが変更されると次の指定セルに移動する。 以下がマクロです。 Private Sub Worksheet_Change(ByVal Target As Excel.Range) Select Case Target.Address(0, 0) Case "E14" [E15].Select Case "E15" [E26].Select Case "E26" [E22].Select Case "E22" [E25].Select Case "E25" [E29].Select Case "E29" [E20].Select Case "E20" [E21].Select Case "E21" [E16].Select Case "E16" [E17].Select Case "E17" [E27].Select Case "E27" [E23].Select Case "E23" [E24].Select Case "E24" [E28].Select Case "E28" [E18].Select Case "E18" [E19].Select End Select End Sub もう一つが、あるセルに数値をいれると他のブックのシートからそのシートの指定した行のセルの 数値を読み込んできて、元のブックのシートに数値を書き込むといったもです。 以下がマクロです。 Private Sub Worksheet_Change_1(ByVal Target As Excel.Range) Dim w As Workbook Dim c As Range On Error Resume Next Set xCur = Selection If Application.Intersect(Target, Range("F3")) Is Nothing Then Exit Sub If Range("F3") = "" Then Exit Sub Application.ScreenUpdating = False '転記元のブックを開いて逆順で検索する Set w = Workbooks.Open("V:\新３係（ＦＩＡ・ｉＰｏｔ）\(2)新４係（ｉＰｏｔ）\ipot進捗\履歴管理\(9)KBB39360　X8 imm1.35 Ｇ１履歴、本体履歴　.xls") Set c = w.Worksheets("対物").Range("B:B").Find(what:=Range("F3").Value, LookIn:=xlValues, lookat:=xlPart, searchdirection:=xlPrevious) '見つけた（一番下の）セルを基準に転記する If Not c Is Nothing Then Range("F4").Value = c.Offset(0, 1).Value End If w.Close False Application.ScreenUpdating = True End Sub ともに1つずつなら問題なく動作するのですが、2個のマクロを組むと片方しか動作しません。 多分ものすごく初歩的な事だとは思いますが、御指導の程宜しくお願いします。

  • VBAで条件付き書式設定

    エクセルの一覧表で2行目から4行ずつ上から商品名、商品コード、会社、商品項目とあって、列がAからXまであります。 以前、商品名ごとに自動で色づけしていた時に使っていたVBAです。 Sub 色分け() Dim Target As Range For Each Target In Range("b2:e2,b5:e5,b8:e8,b11:e11,b14:e14,b17:e17,b20:e20,b23:e23") Select Case True Case InStr(Target.Value, "〇〇") > 0 Target.Resize(4, 1).Interior.ColorIndex = 24 Case InStr(Target.Value, "△△") > 0 Target.Resize(4, 1).Interior.ColorIndex = 38 Case Else Target.Resize(4, 1).Interior.ColorIndex = xlNone End Select Next End Sub この色付け条件を4行目の商品項目ごとに変更したいのですが、方法が分からないので教えてください。 なんかすぐ出来そうな気がするんですけど、丸2日やっても分かりませんでした。 よろしくお願いします。

  • 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

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

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

質問する