増やした列へ決められた文字を入力するには?

このQ&Aのポイント
  • 表のA列の前に1列追加して、新しいA列の3行目のセルから表の最終行に「□」(四角)を表示する方法を教えてください。
  • VBAコードを使用して、表のA列の前に1列追加し、新しいA列の3行目のセルから表の最終行に「□」(四角)を表示する方法を解説します。
  • 「□」(四角)を印刷後に手でチェックを入れるために使用するための方法を教えてください。
回答を見る
  • ベストアンサー

増やした列へ決められた文字を入力するには?

いつもお世話になっております。 表があり、A列の前に1列追加し、その新しいA列の3行目のセルから表の最終行に「□」(四角)を表示するようにしたいのですが、思うように行かず困っております。 「□」は印刷後に手でチェックを入れる為に使うのが目的です。 Sub test() Columns("A").Select Selection.Insert shift:=xlToRight Dim myrow() As Variant Dim i As Integer For i = Cells(Rows.Count, 2).End(xlUp).Row To 2 Step -1 myrow(i, 3) = "□" & i Next End Sub A列は増えるんですが、その先が動きません。 よろしくお願いいたします。 環境はWindowsXP Excel2003です。

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

  • ベストアンサー
  • hige_082
  • ベストアンサー率50% (379/747)
回答No.1

こんな感じ? Sub Macro1() Dim i As Long Columns("A:A").Insert Shift:=xlToRight For i = 3 To Range("B65536").End(xlUp).Row Cells(i, 1).Value = "□" & i Next i End Sub

saiwai
質問者

お礼

深夜にご回答いただき、ありがとうございます。 こちらのやりたい動き通りに動かせる事が出来ました! ありがとうございました!

関連するQ&A

  • VBA 特定の文字列を含む行を削除する方法

    特定の文字列を含む行を削除する方法が知りたいです。 行を削除する方法はWebで見つけたのですが↓ ---------------------------------------------------- Sub 特定の文字列を含む行を削除() Dim c As Range Dim myRow As Long With Range("A:A") Set c = .Find("特定の文字列") Do While Not c Is Nothing Rows(c.Row).Delete shift:=xlUp Set c = .Find("特定の文字列") Loop End With End Sub ---------------------------------------------------- ↑行を指定している箇所のRowsを Columns  RowをColomn に変更して以下の様にしてみました、   Columns(Colomn,c).Delete shift:=xlUp だめでした、、、。 VBAの知識が乏しく、組み立て方について理解が無いため、どうすればよいかさっぱりわからず、、 こちらで質問させて頂きました。。。 何卒宜しくお願い致します。

  • 列を変更して転記したいのですが。

    すみません、誰か教えていただけませんか。 A列に値が入力がされていて、その値をF列に転記していき 15行までいけば2列横にズレて転記していき更に、15行で 2列横と続けたいのですがうまく出来ません。 下記のように記述してみたのですが、値が置き換わるだけで 転記出来ません。 誰か教えて頂けませんでしょうか。 Sub TEST() Dim i As Long, ii As Long Dim myR As Long myR = Worksheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row ii = 5 For i = 1 To myR Cells(1, ii).End(xlUp).Offset(0, 1).Value = Cells(i, 1).Value If Cells(1, ii).End(xlUp).Row = 15 Then ii = ii + 2 End If Next i End Sub 宜しくお願いします。

  • 文字列を分割して、分割した文字の一番右側を表示するにはどうしたら良いのでしょうか?

    Sub test2() Dim moji() As String Dim a As Range Dim 行 As Long For 行 = 2 To Cells(Rows.Count, 1).End(xlUp).Row Set a = Cells(行, 1) moji() = Split(a, "-") On Error GoTo moji Cells(行, 2) = moji(3) Next 行 moji: Cells(行, 2) = moji(2) End Sub で A列 B列 1-2-3-4 4 10-11-11-12 12 1-2-3-10 10 1-2-10-3 3 1-2-3 3 1-2 1-13 11-14 11-3 の結果になりますが1-2,11-14,11-3の部分が表示できません。 どなたかよいほうほうをお願いします。

  • 最終列に入力されている文字を表示する

    エクセルVBAで最終列に入力されている値の表示方法について教えてください。 最終行については表示できるのですが、最終列に入力されているものの表示がうまくいきません。 A列の最終行の値をセル”D1”に表示するについては Private Sub Worksheet_Change(ByVal Target As Range) Dim r As Long r = Cells(Rows.Count, 1).End(xlUp).Row Range("D1").Value = Cells(r, 1).Value End Sub でうまくいきました。 最終行、例えば3列目の10行目に”111”と入力されているときにセル”D1”に”111”と表示するようにはどうしたらよいのでしょうか。 どなたがご指南ください宜しくお願いします。

  • Excel2013VBA列選択の拡大

    ExcelVBA2013です。 列の取得でつまづいております。 お手数ですが、ご教授下さい。 下記のコードで選択範囲のコピー貼り付けは出来ていますが、列幅がコピーされていませんでした。 CC3のセルを基準にOffsetとResizeで範囲拡大してコピーしているためだと思います。 CC3の左隣のAX3:CB3はセル結合されています(○月)。(その下の4行目は日付の1~31が入力) 列は、今回はAX3:CC3まで(1月分)取得できればよいです。(可変します) MaxCol = Range("J5").End(xlToRight).Column  で列取得できます。 行の位置は、MaxRow = Range("I5").End(xlDown).Row  で取得した値です。 それで、列全体を取得しようと、 MaxCol = Columns(MaxCol).Select で最終列は取得できましたが、そこから列選択の拡大ができればと思っています。 現在は、AX3:CC237まで取得コピーして、隣の列に貼り付けで列幅が違う。 希望はAX:CCまでの列を取得選択コピーして貼り付け。 Sub SAMPLE() Dim MaxRow As Variant, MaxCol As Variant Dim r As Range, c As Range MaxRow = Range("I5").End(xlDown).Row '最終行番号 MaxCol = Range("J5").End(xlToRight).Column '最終列番号 Set c = Cells(3, Cells(3, Columns.Count).End(xlToLeft).Column) '表の右上角のセル番地を取得 c.Select c.Offset(0, -31).Resize(MaxRow - 2, 32).Copy c.Offset(0, 1) '表右上から1月分選択範囲拡大してコピー隣の列より貼りつけ End Sub

  • ある列の計算式が入っているセルの行のみを削除したい

    Excel2007でマクロを作成している超初心者です。 B列のセルには 空白 文字列 計算式が入っています。このうち計算式の入っているセルの行のみを削除したいのですが、どうしたらよろしいでしょうか?  セルには =IF(C17="","",+K17*L17)という式が入っています。 次式は0か空白の場合ですが、これをどのように修正したらできるでしょうか? Sub 行の削除() Dim i As Long For i = 1 To Selection.End(xlDown).Columns Step 1 Select Case Range("B" & i).Value Case 0, "" Columns(i).Delete End Select Next End Sub

  • Excel2000VBAで貼り付け先の取得等・・・

    シートに行数13、列数不定の表が上下に多数配置されてます。表は上下それぞれ2行の空白行で隔てられています。 各表は連続した列の部分でひとつですが、中には複数の表を横にならべて、途中1列の空白列で間隔をあけたものもあります。 この、複数の表を横に並べたものを上下に配置しなおすため、以下のように書きました。 質問です。 1.Dim ans As Variantは 'variantで正しいですか? 2.15行(13行+間隔用2行)挿入にForNext以外にいい方法はないですか? 3.切り取った部分を貼り付ける際、Set XRng = SelectionでなくセレクトせずにXRngを取得できませんか? 他に指摘事項があればお願いします。 Sub TEST() Dim ans As Variant Dim Rng As Range, XRng As Range Dim c As Integer, b As Integer, i As Integer, n As Integer, x As Integer ans = MsgBox("分離したい表を選択してある?", vbYesNo + vbQuestion) If ans = vbNo Then Exit Sub Set Rng = Selection b = Application.CountBlank(Range(Rng(2, 1), Rng(2, Rng.Columns.Count))) '分離する数を取得 Set XRng = Rng For i = 1 To b'分離する数だけ繰返し For n = 1 To 15 '行挿入 XRng.Offset(14, 0).Resize(1, 1).EntireRow.Insert Shift:=xlDown Next n c = XRng.Columns.Count '列数取得 x = Range(XRng(1, 1), XRng(1, 1).End(xlToRight)).Columns.Count '最左側部分の列数取得 XRng.Offset(0, x + 1).Resize(13, c - x - 1).Cut '右側カット Rng.Offset(15 * i, 0).Resize(1, 1).Select '貼付け開始位置セレクト ActiveSheet.Paste '貼付け Set XRng = Selection 'XRng再取得 Next i End Sub

  • 列をアルファベットではなく数値で指定するには

    Vbaで条件付き書式を付ける場合、 列をアルファベットではなく数値で指定するにはどうすればいいですか? Sub Macro() Dim i As Long i = 1 Columns(i).Select Selection.FormatConditions.Delete Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=A1=""aaa""" Selection.FormatConditions(1).Font.ColorIndex = 3 '文字色を赤にする End Sub この場合の、 Formula1:="=A1=""aaa"""のA1を Cells(1,i)みたいにしたいのですが、やり方を教えてください。

  • 1列目の何行目に検索文字があるかを取得したい

    しかしエラーになってしまいます。 エラーの原因がわかりません。 シートの1列目のどこかに「test」と入っている行があるのですが Sub test1() Dim myRow As Long With Sheets("Sheet") myRow = .Column(1).Find(What:="test").Row MsgBox .Cells(myRow, 1) End With End Sub このvbaコードを実行するとエラーになります。 コードとしては「.Column(1)」で1列目と言う意味で、 .Find(What:="test")で、何行目に「test」があるかを取得するという意味だと思うのですが 実行時エラー438が発生します。 実際にtestと言う文字は2行目にあるのですが なぜmyRowに2が代入されないのでしょうか?

  • A列の最終行までハイパーリンクを付けたい

    A列の最終行までハイパーリンクを付けたいのですがコードがわかりません。 Sub test() Dim i As Long For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row 'ハイパーリンクにするコード Next i End Sub まではわかりました。 表示文字列もURLもセルに入ってる値にしたいです。 ご教授よろしくお願いします。

専門家に質問してみよう