特定範囲のセルの最終文字1文字を削除

このQ&Aのポイント
  • VBAを使用して、特定範囲のセルの最終文字を削除する方法を教えてください。
  • セルの値が空でない場合にのみ、最終文字を削除するように設定してください。
  • エラーが表示される場合は、For Eachループの構文を修正してください。
回答を見る
  • ベストアンサー

特定範囲のセルの最終文字1文字を削除

よろしくお願いします。 Sheet1のJ26からJ56の、セルに入れた文字の最終文字1文字を 削除して表示したいのですが、下の構文で、 For Each r In Application.Selectionが黄色くエラー表示されます。 どこをどのように直せばよいのか解りません。 よろしくお願いします。 Private Sub CommandButton1_Click() Dim r As Range r = Worksheets("Sheet1").Range("J26:J56") For Each r In Application.Selection If Len(r.Value) > 0 Then r.Value = Left(r.Value, Len(r.Value) - 1) End If End Sub Next

  • 1211M
  • お礼率54% (90/165)

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

  • ベストアンサー
  • Chiquilin
  • ベストアンサー率30% (94/306)
回答No.2

よく見たら Rangeオブジェクトの代入の仕方もおかしいです。 というより選択した範囲の中のセルを指定しているはずなのに 範囲 を変数に入れようとしているのは意味不明ですね。 Private Sub CommandButton1_Click() Dim r As Range For Each r In Worksheets("Sheet1").Range("J26:J56") If Len(r.Value) > 0 Then r.Value = Left(r.Value, Len(r.Value) - 1) End If Next End Sub

1211M
質問者

お礼

Chiquilin様 早いご回答ありがとうございます。 完璧に思い通りにできました。 感謝します。 今後もよろしくお願いします。

その他の回答 (3)

  • imogasi
  • ベストアンサー率27% (4737/17068)
回答No.4

質問者のエラー原因は、既回答でご指摘の通りで、お粗末。 参考 下記のような、他の方法も勉強したら。 エクセル関数でできる課題だし。 J29:J30に文字列があるとして、右隣セルに結果を出す場合 標準モジュールに Sub test01() Sheets("Sheet1").Range("K25:K30").Formula = "=LEFT(J25,LEN(J25)-1)" End Sub 実行して、結果 J列  K列 werty wert erty ert d123ll d123l pseadq psead 112あ 112 345tyu1 345tyu たった1行です これを選択(対象)としている、セル範囲の列数分だけ繰り返す。

回答No.3

ちょっとした英語の問題ですかねぇ。 「For Each 〇〇 in △△」 ですから、「△△の中のそれぞれの〇〇」ですね。 > Sheet1のJ26からJ56の、セル について処理をしたいわけですから、解釈的には   For Each セル In Sheet1のJ26からJ56 です。 > r = Worksheets("Sheet1").Range("J26:J56") と代入しているので、簡略して   For Each セル In r と書けますね。 そんなわけで、 Private Sub CommandButton1_Click() Dim r As Range, sh As Range   ' Range型の変数に代入するときはSetを使いますよ。   Set r = Worksheets("Sheet1").Range("J26:J56")   For Each sh In r     If Len(sh.Value) > 0 Then       sh.Value = Left(sh.Value, Len(sh.Value) - 1)     End If   Next End Sub と書けばうまくいくのではないかな、と思いますよ。 ご提示のコードを最大限活かそうと思ったら、 Private Sub CommandButton1_Click() Dim r As Range   Worksheets("Sheet1").Range("J26:J56").Select   For Each r In Selection     If Len(r.Value) > 0 Then       r.Value = Left(r.Value, Len(r.Value) - 1)     End If   Next End Sub こんな感じで、代入しないで 先に「Select」してやると良いかもしれません。

  • Chiquilin
  • ベストアンサー率30% (94/306)
回答No.1

「End Sub」の後に「Next」がくるのはどう考えてもおかしいでしょう。 「Sub~End Sub」の中に「For ~Next」を入れて下さい。

1211M
質問者

補足

Chiquilin 様 早速の回答ありがとうございます。 「Sub~End Sub」の中に「For ~Next」を入れて下さい。 この入れ方?がわかりません。 Private Sub CommandButton1_Click() Dim r As Range r = Worksheets("Sheet1").Range("J26:J56") For Each r In Application.Selection If Len(r.Value) > 0 Then r.Value = Left(r.Value, Len(r.Value) - 1) End If Next End Sub

関連するQ&A

  • 指定したセル範囲に入力された文字のみに*をつけたい

    これは2枚目のシートにデータが入っていてそのデータを抽出シートのA1を基準とする範囲を 検索条件として抽出シートのA7に取り出すというものです。 For Each r In Range("A2:I4") If IsNumeric(r.Value) Then r.Value = r.Value ElseIf Len(r.Value) >= 0 And Left(r.Value, 1) <> "*" Then r.Value = "*" & r.Value End If Next Sheets(2).Range("A1").CurrentRegion.AdvancedFilter _ Action:=xlFilterCopy, _ CriteriaRange:=Sheets("抽出").Range("A1").CurrentRegion, _ CopyToRange:=Sheets("抽出").Range("A7"), Unique:=False For Each 以降の式で検索条件を入力するだろうと思われるA2:I4に、文字が入力されていれば 先頭に*をいれて *ABCのようにし、数値が入力されていれば*はつけないという処理をさせたいのです。 人に教えてもらった式に自分なりに考えて記述したのですが、Elseif以降の処理を全くしてくれません。現状は文字を入力しても頭に*はつかないです。 多分式の入力が間違っているのだと思うのですが、自分ではどこがおかしいのか どうすれば動くのかお手上げ状態です。 どなたかわかる方教えていただけないでしょうか? このマクロは月曜日にどうしても必要なので急いでいるんです。 どうぞよろしくお願いいたします。

  • エクセルで特定の文字列の含まれるセルのある行の色を変更したいと思ってお

    エクセルで特定の文字列の含まれるセルのある行の色を変更したいと思っておりますが、関数では出来ないようなのでVBAで作業をしております。なかなかうまくいかずで困ってしまっております。 下記のような関数でシート一枚は出来たのですが、それ以外のシートには反映がされません。 Private Sub Worksheet_Change(ByVal Target As Range) Dim r As Range If Application.Intersect(Target, Range("A2:A10000")) Is Nothing Then Exit Sub For Each r In Target If r.Column = 1 Then Select Case r.Value Case "○": r.Resize(1, 12).Interior.ColorIndex = 19 Case "×": r.Resize(1, 12).Interior.ColorIndex = 3 Case "△": r.Resize(1, 12).Interior.ColorIndex = 6 Case Else: r.Resize(1, 12).Interior.ColorIndex = xlNone End Select End If Next r End Sub 無知なので、ネットで調べて上記のような数式を拾ってきたのですが、どうやら1シート分の設定に書かれているようです。。。 全シートに反映がされるように設定をするにはどこをどのように書き換えればよろしいでしょうか。 お分かりの方がいらっしゃいましたら、よろしくお願いいたします。

  • エクセルVBA 先頭と末尾(後尾)に文字入力する

    エクセルVBAについて教えてください (1)選択した複数のセルに文字入力がされていた場合、入力文字の先頭に*を入力させたい (2)選択した複数のセルに文字入力がされていた場合、入力文字の末尾(後尾)に*を入力させたい (3)選択した複数のセルに文字入力がされていた場合、入力文字の先頭と末尾(後尾)に*を入力させたい (1)一応、これで先頭に*が入力されました Sub test1() Dim c As Range For Each c In Selection If Len(c.Value) > 0 Then c.Value = "*" & c.Text Next End Sub (2)失敗(構文エラーになります) Sub test2() Dim c As Range For Each c In Selection If Len(c.Value) > 0 Then c.Value = c & "*".Text Next End Sub どのようにしたら、末尾に*を入力させられるのでしょうか (3)不明 (1)はできたのですが、(2)(3)はどうしたらよいか分かりません もし、(1)も変更した方が良いのであればそれも教えてください よろしくお願いします

  • VBA For Eachでセル内の文字列を一個ずつ取り出すには

    エクセル2000です。 たとえばA1セル内の文字列を一個ずつ取り出す場合、 Sub test01() For i = 1 To Len(Range("A1").Value) Cells(i, "B").Value = Range("A1").Characters(i, 1).Text Next End Sub このように最初から最後の文字まで何番目で指定することはわかるのですが、これをFor Each で回すにはどうしたらよいでしょうか? (⌒o⌒)? お教えください。 Sub test02() For Each ch In Range("A1").Characters i = i + 1 Cells(i, "B").Value = ch Next End Sub ではエラーになります。

  • 二つの条件式を一つにまとめようとしてます。

    二つの条件式を一つにまとめようとしてます。 マクロを勉強しております。以前も質問させて頂いて、やりたい事は解決出来たのですが、更に別の事をしようと思いつまずきました。 A列の17行目まで数値が記入してあり、その順位をB列に記入するマクロを作りました。ここまでは何とか教えて頂いて出来たのですが。 さらに背景色が付いているセルを空欄にしてから順位を出そうとしました。それで、自分なりに記入して出来たのですが、この二つを一つにまとめようとしたらうまくいきません。Select case ~などを使用してみたのですが、よく分からなくなりました。どのようにしたらよいかだれか教えてください。 Sub Macro2() Dim r As Range Range("A1:A17").Select For Each r In Selection If r.Interior.ColorIndex <> xlNone Then r.Value = "" End If Next r End Sub Sub Macro1() Dim r As Range, a As Range Range("A1:A17").Select For Each r In Selection If r.Value <> "" Then r.Offset(, 1).Value = Application.WorksheetFunction.Rank(r, Selection, 1) End If Next r End Sub あと、Select しない書き方も研究してください。と指摘、頂いたのですがまだ未解決なので、そこはそのままになっております。

  • セル範囲内値の一文字削除

    表-1のようにセル範囲A1:A9、A10:A20があり左1文字のみ削除し表-2のようにしたいのですが。 下記のコードでは空白セルにてどうしてもエラーが生じます。どなたか解る方よろしくお願いします。 Sub 文字削除() Dim i, w For i = 1 To 9 w = Range("A" & i) Range("A" & i) = Right(w, Len(w) - 1) '←この部分でエラー発生 Next For i = 10 To 20 w = Range("A" & i) Range("A" & i) = Right(w, Len(w) - 1) Next End Sub

  • Excelのプロシジャーで有効範囲のセルを限定したい

    Excelの「コードの表示(V)」に、下記のフォントサイズ変更コードを登録してあります。この有効範囲を、あるセル範囲、たとえば(C3:S20) などのように限定したいのですが、どう記述したらよいのでしょうか、教えて下さい。よろしくお願いします。 (現在のコード) Private Sub Worksheet_Change(ByVal Target As Range) Dim c As Range Application.EnableEvents = False For Each c In Target If IsNumeric(c.Value) Then If Len(Mid$(c.Text, InStr(c.Text, ".") + 1)) > 1 Then c.Font.Size = 8 Else c.Font.Size = 9 End If End If Next c Application.EnableEvents = True End Sub

  • 自前設定マクロはセキュリティー上、問題ないのか?

    セル内に256文字以上の文字を入力する場合、以下のマクロ設定を行ないますが、マクロセキュリティが”高”に設定している場合、送信先にて開いた場合、マクロが無効となってしまいます。 もちろん、セキュリティを低に下げても良いのですが、本当に大丈夫かという確証がありません。(大丈夫であれば、セキュリティを下げて運用せざるえないのでしょうか。) もし、セキュリティーを”高”の状態で以下のマクロ設定が無効になったりしないようにすることはできるのでしょうか。教えてください。 また、セキュリティーを下げるしかない場合は、それでなんら問題ないのでしょうか(なぜ、マイクロソフトは「推奨しない」とわざわざ記載しているのでしょうか。運用する皆さんが心配性なので教えてください) :********************************************** シートタブを右クリック、コードの表示を選択 出てきたシートモジュールにコピペ 表示形式は標準に戻す Private Sub Worksheet_Change(ByVal Target As Range) Dim Rng As Range If Not Intersect(Range("a1:a10"), Target) Is Nothing Then Application.EnableEvents = False For Each Rng In Target Rng.Value = "故障状況" & Rng.Value Next Application.EnableEvents = True End If End Sub **************************************** VBEにてマクロコードをコピーペーストします。 '標準モジュール Option Explicit Sub try()   Dim r As Range   If TypeName(Selection) = "Range" Then     With Selection       .NumberFormat = "general"       For Each r In .Cells         If r.Value <> "" Then           r.Value = "故障状況" & r.Value         End If       Next     End With   End If End Sub

  • ExcelVBA データのコピー範囲について

    あけましておめでとうございます。今年もよろしくお願いします。 Sub Test() Dim myTarget As Range, r As Range, f Set myTarget = Sheets("Sheet1"). _    Range("B2", Sheets("Sheet1").Range("B65536").End(xlUp)) For Each r In myTarget  Set f = Sheets("Sheet2").Columns(1). _    Find(r.Value, Sheets("Sheet2").Range("A1"), Lookat:=xlWhole)  If Not f Is Nothing Then    If r.Offset(0, 3).Value <> f.Offset(0, 3).Value Then      f.Resize(1, 4).Copy Destination:= _      Sheets("Sheet3").Range("A65536").End(xlUp).Offset(1, 0)    End If  End If Next r End Sub 前回の質問で教えていただいたコードなのですが、現時点では、B列のデータを元にして二つのSheetのデータを比較して別Sheetへコピーしているのですが、そのときに、B列以降の(たとえば、B列からX列まで)データはコピーできますが、A列もコピーしたい時はどうすればよいのかで、悩んでいます。どの様に変更すればよいのでしょうか?

  • 空白セルに●を入れたい

    Excelのセル範囲(例:としてA1からC10)のセルを調べて、 空白のセルになにかの文字(例:●)を打ち込みたい場合のVBAの書き方を教えてください。 Sub セル埋め() Dim r As Range, i As Range Set r = Range("A1:C10") '範囲指定 If Intersect(r, Target) Is Nothing Then For Each i In r If i.Value = "" Then i.Value = "●" Next i End Sub この書き方にこだわっているわけではないので、もっと簡単なやり方でもけっこうです。

専門家に質問してみよう