• ベストアンサー

【VBA】 通し番号の入力について

こんばんは。 こちらの識者の方々にはいつもお世話になっています。 VBAの件で質問があります。 B列の最終行までA列に001から文字列で連番を振りたい場合、どのような構文になりますでしょうか。 Range("A1:A" & Range("B" & Cells.Rows.Count).End(xlUp).Row).Value = Format(row, "000") は通らなかったのですが、なにかいい構文はありますでしょうか。 データは必ず1000行以下ですので、番号は3桁で大丈夫です。 よろしくお願いいたしますm(_ _)m

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

  • ベストアンサー
  • cj_mover
  • ベストアンサー率76% (292/381)
回答No.3

こんにちは。お邪魔します。 あれこれ考えていたら新しい回答が付いていました。 既に私が回答しようという理由はなくなったのですが せっかくなのでコードだけあげてみます。 いや、しかし、余りにも多様なので、どのような志向か限定しないと きりがないかも知れませんね。 一応、私自身が普段書き分けている4つの志向で4タイプです。 ' ' ================================================== ' ' コンサバティブ版 Sub Re7820341c()   Dim nRowOffset As Long   Dim nBtm As Long   Dim i As Long ' ' 項目タイトルが1行の(つまり2行目からナンバリングする)場合   nRowOffset = 1   nBtm = Range("B" & Cells.Rows.Count).End(xlUp).Row   For i = 1 To nBtm - nRowOffset     Cells(i + nRowOffset, 1) = Format(i, "'000")   Next i End Sub ' ' -------------------------------------------------- ' ' Excel一般機能活用版(値は数値、表示は"000") Sub Re7820341a()   Cells(1) = 1   With Range("A1:A" & Range("B" & Cells.Rows.Count).End(xlUp).Row)     .DataSeries Rowcol:=xlColumns, Type:=xlLinear, Step:=1, Trend:=False     .NumberFormat = "000"   End With End Sub ' ' -------------------------------------------------- ' ' 配列(高速仕様)版 Sub Re7820341j()   Dim nBtm As Long   Dim nTop As Long   Dim i As Long Columns(1).Clear ' ' 3行目からナンバリングする場合   nTop = 3   nBtm = Range("B" & Cells.Rows.Count).End(xlUp).Row   ReDim mtxPrint(nTop To nBtm, 1 To 1)   For i = nTop To nBtm     mtxPrint(i, 1) = Format(i - nTop + 1, "'000")   Next i   Range("A" & nTop & ":A" & nBtm).Value = mtxPrint End Sub ' ' -------------------------------------------------- ' ' 短い記述のマニアック版 Sub Re7820341jj()   Dim sRef As String   sRef = "A1:A" & Range("B" & Cells.Rows.Count).End(xlUp).Row   Range(sRef).Value = Application.Evaluate("transpose(text(transpose(row(" & sRef & ")),""'000""))") End Sub ' ' ==================================================

rihitomo
質問者

お礼

いろいろとやり方があるんですね。 いずれの方法でもできました。 自分でも一つ一つ紐解きながら勉強していきたいと思います。

その他の回答 (3)

  • keithin
  • ベストアンサー率66% (5278/7940)
回答No.4

もう一個、アポストロフィなしの文字列で記入: sub macro3()  with range("A1:A" & range("B65536").end(xlUp).row)   .formula = "=TEXT(ROW(A1),""000"")"   .numberformat = "@"   .value = .value  end with end sub #言わずもがなですが 既に寄せられている回答の幾つかのマクロでやってるように、「文字列で記入」を止めてふつーに数値で記入し、表示形式で001と表示させた方がはるかに簡単です。

rihitomo
質問者

お礼

具体例を2つも提示していただいてありがとうございます。 とても参考になりました。

  • keithin
  • ベストアンサー率66% (5278/7940)
回答No.2

こんばんは。 >文字列で連番を振りたい 一応ご相談に忠実に。まぁ趣味に応じて手口は様々ですが。 sub macro1()  range("A:A").clearcontents  range("A1").characters.text = "001"  range("A1").autofill range("A1:A" & range("B65536").end(xlup).row), xlfillseries end sub もちろん sub macro2()  dim r as long  for r = 1 to range("B65536").end(xlup).row  cells(r, "A") = format(r, "'000")  next r end sub とかしても、1000行以内程度ならそんなに目に見えて遅いことは無いだろうと思います。

  • tom04
  • ベストアンサー率49% (2537/5117)
回答No.1

こんばんは! 色々やり方はあると思いますが、 一例です。 Sub 連番() Dim i As Long i = Cells(Rows.Count, 2).End(xlUp).Row With Range(Cells(1, 1), Cells(i, 1)) .Formula = "=row()" .NumberFormatLocal = "000" End With End Sub ※ A列には数式が入っています。 実データにしたい場合は Sub 連番2() Dim i As Long For i = 1 To Cells(Rows.Count, 2).End(xlUp).Row With Cells(i, 1) .Value = Cells(i, 1).Row .NumberFormatLocal = "000" End With Next i End Sub といった感じではどうでしょうか?m(_ _)m

関連するQ&A

  • 最終行/処理対象のデータまでを表すVBA

    こんばんは、データの最終行/処理する対象のセルまで処理する場合のVBAの記述について質問させてください!VBAの最終行/処理する対象のセルまで選択するために使用する記述方法が何種類かありますが、そのうち、書籍やネットで検索しても出てこない記述方法について今一つ理解ができていません(T_T) 本屋で売っている書籍やネットで検索すると出てくる記述方法 Range~.End(xlUp).Row Range~.CurrentRegion Range~.SpecialCells(xlLastCell) Range~.Cells(Rows.Count, 1).End(xlUp).Row 上記のようなVBAは書籍やネットで検索すると説明や違いについても出てくるので、説明を読めば理解ができるのですが、 Sheets("テスト").Range("A1:C" & Sheets("テスト").Cells _(1).CurrentRegion.Rows.Count) Range("A1").CurrentRegion.Cells(Range _("A1").CurrentRegion.Cells.Count).Row 上記のようなVBAについては検索しても説明など出てこないうえに、 なぜ上記のような記述になるのかあまり理解できていません(>_<) 書籍やネットで検索すると出てくる「Range~.CurrentRegion」などの記述方法から何となく、CurrentRegionやCells.Countを使わないといけないというのは理解できますが、なぜ「~CurrentRegion.Rows.Count)」はRowsがカッコの中に入っていて、「~CurrentRegion.Cells.Count).Row」はカッコの外に出ているのか??といった細かいことが分からずにいます。。。 半ば丸暗記のようにして使ってしまっているのですが、もし上記のようなVBAについてわかるかたがいらっしゃれば、ご教授いただけるととても嬉しいです! また、上記以外にもまだ検索しても出てこないようなVBAがあるのでしょうか?? 頭が混乱しそうです!(゜Д゜;)

  • EXCEL VBA 早く処理をする

    よろしくお願いします 下の構文を標準モジュールに書き込み、callで実行しているのですが 処理に時間がかかります。 処理を早くする方法と構文の簡素化のご教示をお願いします。 Application.ScreenUpdating = False For i = 1 To 12 With Worksheets(i) .Select LastRow = .Range("A150").End(xlUp).Row + 1 .Range("A8:G" & LastRow).Sort Key1:=Range("A8"), order1:=xlAscending .Range("G8:G" & LastRow - 1).Formula = "=G7+E8-F8" LastRow = .Range("A150").End(xlUp).Row + 1 .Range("A" & LastRow).Select Dim EndRow As Long EndRow = .Range("A" & Rows.Count).End(xlUp).Row Cells(Rows.Count, 1).End(xlUp).Offset(1, 3) = .Name & "合計" Cells(Rows.Count, 1).End(xlUp).Offset(1, 4) = Application.WorksheetFunction.Sum(Range("E7:E" & EndRow)) Cells(Rows.Count, 1).End(xlUp).Offset(1, 5) = Application.WorksheetFunction.Sum(Range("F7:F" & EndRow)) Cells(Rows.Count, 1).End(xlUp).Offset(2, 3) = "前月繰越" Cells(Rows.Count, 1).End(xlUp).Offset(2, 4) = .Range("G7") Cells(Rows.Count, 1).End(xlUp).Offset(2, 5) = "" Cells(Rows.Count, 1).End(xlUp).Offset(3, 4) = "" Cells(Rows.Count, 1).End(xlUp).Offset(3, 3) = "次月繰越" Cells(Rows.Count, 1).End(xlUp).Offset(4, 3) = "合計" Cells(Rows.Count, 1).End(xlUp).Offset(3, 5) = Cells(Rows.Count, 1).End(xlUp).Offset(2, 4) + Cells(Rows.Count, 1).End(xlUp).Offset(1, 4) - Cells(Rows.Count, 1).End(xlUp).Offset(1, 5) Cells(Rows.Count, 1).End(xlUp).Offset(4, 4) = Cells(Rows.Count, 1).End(xlUp).Offset(2, 4) + Cells(Rows.Count, 1).End(xlUp).Offset(1, 4) Cells(Rows.Count, 1).End(xlUp).Offset(4, 5) = Cells(Rows.Count, 1).End(xlUp).Offset(3, 5) + Cells(Rows.Count, 1).End(xlUp).Offset(1, 5) Cells(Rows.Count, 1).End(xlUp).Offset(1, 6) = "" Cells(Rows.Count, 1).End(xlUp).Offset(2, 6) = "" Cells(Rows.Count, 1).End(xlUp).Offset(3, 6) = "" Cells(Rows.Count, 1).End(xlUp).Offset(4, 6) = Cells(Rows.Count, 1).End(xlUp).Offset(0, 6) .Range("C7").End(xlDown).Select Selection.Offset(4, 2).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(4, 2).Borders(xlEdgeBottom).LineStyle = xlDouble Selection.Offset(4, 3).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(4, 3).Borders(xlEdgeBottom).LineStyle = xlDouble Selection.Offset(4, 4).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(4, 4).Borders(xlEdgeBottom).LineStyle = xlDouble Selection.Offset(0, 2).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(0, 2).Borders(xlEdgeBottom).LineStyle = xlContinuous Selection.Offset(0, 2).Borders(xlEdgeBottom).Weight = xlThin Selection.Offset(0, 3).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(0, 3).Borders(xlEdgeBottom).LineStyle = xlContinuous Selection.Offset(0, 3).Borders(xlEdgeBottom).Weight = xlThin Selection.Offset(0, 4).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(0, 4).Borders(xlEdgeBottom).LineStyle = xlContinuous Selection.Offset(0, 4).Borders(xlEdgeBottom).Weight = xlThin End With Next i Application.ScreenUpdating = True

  • VBA 最終列に入力された値の表示について

    VBAで最終列に入力された値の表示について教えてください。 例えば10行目の10列目(J列)に”123”と入力された値をセル”D1”に表示させたいのですがどのようにすればよいのでしょうか。 A列の最終行については 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 でうまく表示できたのですが、最終列についてなかなかうまくいきません。 どなたかご指南ください宜しくお願いします。

  • VBAについて

    はじめまして、以下のVBAについて質問させてください。 A列にデータの個数だけ連番を振りたくて、以下のVBAを入力しました。 連番を振るシートは複数あり、そのシートによってデータの個数は異なります。 しかし、以下のVBAだと最初のシートの個数に応じて、後のシートの連番も振られてしまいます。データの個数に応じてシートごとに連番を振るには、どうすればよいのでしょうか…?!どうか迷える子羊をお助け下さい(T_T) '一番はじめのシートを選択 Sheet "一番".Select 'A列に連番を振る Dim sh As Variant For sh = 3 To Worksheets.Count Dim number As Integer Dim 行2 As Long number = 1 '2行目~最終行までループ For 行2 = 3 To Cells(Rows.Count, 2).End(xlUp).Row Worksheets(sh).Cells(行2, 1) = number number = number + 1 Next 行2 Next sh

  • VBAでの処理分岐方法を教えてほしいです

    VBAの分岐処理で悩んでおります。 誰かお助けお願いします。 A列に昇順で番号があります。 1 2 4 4 5 6 9 欠番や重複した数値があります。 やりたいことは欠番箇所に行を挿入し、連番にしたいです。 この例で言うと、3行目に1行を挿入し番号を3と入れる、6行目に2行挿入し7,8と連番にする。 連番になった後に、重複した数値に色を付けます。 以下私が作成したコードです。callで呼び出す予定です。 Sub 欠番判定数式() Dim i As Integer For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row Cells(i, 3) = "=if(iserror(if(A" & i & "-A" & i - 1 & ">1,""○"","" "")),"""",if(A" & i & "-A" & i - 1 & ">1,""○"","" ""))" Next End Sub Sub 行挿入() Dim c As Range, Target As Range For Each c In Range("C2:C" & Cells(Rows.Count, 1).End(xlUp).Row) If c = "○" Then If Target Is Nothing Then ''(1) Set Target = c Else Set Target = Union(Target, c) ''(2) End If End If Next c If Not Target Is Nothing Then Target.Select Selection.EntireRow.Insert , copyorigin:=xlFormatFromLeftOrAbove End Sub Sub 空白連番入力() Dim i As Integer For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row If Cells(i, 1) = "" Then Cells(i, 1) = (Cells(i, 1).Offset(1, 0).Value) - 1 End If Next End Sub Sub 番号重複確認() Dim i As Integer For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row If Application.WorksheetFunction.CountIf(Range("$A$2:$A$" & Cells(Rows.Count, 1).End(xlUp).Row), Range("A" & i)) <> 1 Then Cells(i, 1).Interior.ColorIndex = 3 End If Next End Sub このコードを順に全て実行した時、1回目の処理で3行目と5行目に行挿入、そして番号が3と7と入力され連番に色が設定されます。 再度「欠番判定数式」を行い、次は8行目に行挿入し8と連番を入力させ処理を繰り返しさせたいです。 欠番は例として最高2個にしてますが、これから2個以上の可能性もあります。 一度全処理終了後、再度最初の処理(欠番判定数式)に戻り、欠番がある場合は行挿入させという処理を行わせ、欠番がない場合は次の処理に進めるという分岐方法を教えてほしいです。 よろしくお願いいたします

  • Excel vbaのClearについて

    よろしくお願いします。 Excel2003使用です。 最終行を指定して、それを使って動作をしたいのですが、、うまく動作しません。 A列~D列まで入力があり、A列の52行目からD列の最終行までをClearしたいのです。 Set ps = ThisWorkbook.Worksheets("●●") LastRow = ps.Cells(ps.Rows.Count,1).End(xlUP).Row ps.Range(Cells(52,1),Cells(LastRow,4)).Clear →Error1004がでます うまく動く方法をご存じな方、よろしくお願いします。

  • range表記をcells表記にしたい

    B列の最終行までループさせたいのですが Sub Sample() Dim col As Long col = 2 For Each R In Range("B1:B" & Cells(Rows.count, "B").End(xlUp).Row) Next End Sub この状態から、Bを使わずに、 col = 2を使って、書き換えてもらっても良いですか? For Each R In Range(Cells(1, col), Cells((Rows.count, col)).End(xlUp).Row) これにするとエラーになります。

  • 【VBA】"オブジェクトが必要です"メッセージ出力

    VBAを使用し、A列に日付、B列に数量、C列に単価、D列に金額を入力し、 数量*単価にて、金額を求めるVBAを作成しています。 そこまでは上手くいくのですが、D列で求めた金額を最終行で合計する事で 躓いてしまっています。 行は常に追加され可変の為、最終行を「Cells(Row.Count, 1).End(xlUp).Row」 にて引っ張ってこようと思っております。以下のようなVBAを記載しましたが、 「オブジェクトが必要です」とのメッセージがでて、処理が上手くいきません。 どのような問題があるのか、お分かりの方、ご回答頂けますと幸いです。 ■環境  Windows7  Excel2010 ■VBA Sub test() Dim i As Long Dim j As Long Dim k As Long For i = 2 To Cells(Row.Count, 1).End(xlUp).Row Cells(i, 4) = Cells(i, 2) * Cells(i, 3) Next j = Cells(Row.Count, 1).End(xlUp).Row + 1 k = Cells(j, 1).End(xlUp).Row Cells(j, 4) = WorksheetFunction.Sum(Cells(2, 4), Cells(k, 4)) End Sub

  • アプリケーション定義または、オフジェクトエラー

    office2010 マクロ実行で”アプリケーション定義または、オフジェクトエラー"が発生します いろいろ調べてみたのですが、原因分からず、教えてください。 Sheet1のA1~A8までシート名が記載されています。 このシート名の後ろにdataを付与してシートを追加し、編集用とするマクロです。 Macro13を実行してMacro1のエラー発生という所が黄色くなります。 ' Range("E1:S" & Worksheets(Worksheets("SHEET1").Cells(i, 1).Value).Range("B" & Rows.Count).End(xlUp).Row).Value = "=A1管理!RC[-4]" の場合は、動作します。 なので、 Worksheets(""SHEET1"").Cells(i, 1).value! が悪いと思うのですが、どうしたらよいかが分かりません。 Dim i As Long Sub Macro13() ' Sheets("Sheet1").Select For i = 1 To Range("A1").End(xlDown).Row With Worksheets.Add() .Name = Worksheets("SHEET1").Cells(i, 1) & "data" Call Macro1 End With Next End Sub Sub Macro1() ' 各シートの整列版作成 ' 'データ参照 ' Range("E1:S" & Worksheets(Worksheets("SHEET1").Cells(i, 1).Value).Range("B" & Rows.Count).End(xlUp).Row).Value = "=A1管理!RC[-4]" '動作Ok Range("E1:S" & Worksheets(Worksheets("SHEET1").Cells(i, 1).Value).Range("B" & Rows.Count).End(xlUp).Row).Value = "=Worksheets(""SHEET1"").Cells(i, 1).value!RC[-4]" ’エラー発生 '下記は編集内容 'D列:F列を参照し、先頭6桁の右3文字がドライだったらTD、先頭6桁の右3文字がレンチだったらTL Range("D1:D" & Range("E" & Rows.Count).End(xlUp).Row).Value = "=IF(RIGHT(LEFT(RC[2],6),3)=""ドライ"",""TD"",IF(RIGHT(LEFT(RC[2],6),3)=""レンチ"",""TL"",""""))" '計算用に1行ダミー行挿入 Range("A1").Select Selection.EntireRow.Insert 'C列:E列を参照し、セル結合されているセルを名称、フロント、リアの区分名とする Range("C2:C" & Range("E" & Rows.Count).End(xlUp).Row).Value = "=IF(RC[2] <>0,RC[2],R[-1]C)" 'B列:E列を参照し、先頭1桁がNだったら名称、0だったらB列1つ上の名称 Range("B2:B" & Range("E" & Rows.Count).End(xlUp).Row).Value = "=IF(LEFT(RC[3],1)=""N"",RC[3],R[-1]C)" 'A列:B,C,D列を結合 Range("A2:A" & Range("E" & Rows.Count).End(xlUp).Row).Value = "=IF(RC[1]=RC[2],"""",CONCATENATE(RC[1],RC[2],RC[3]))" End Sub

  • VBA 高速化

    以下のコードを改良して早く処理できるようにしたいです。素因数分解をして、素因数の数を数えるプログラムです。 Sub 素因数を数える() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Dim I As Long, j As Long, cnt As Long, wS As Worksheet, k As Long, Set wS = Worksheets("Sheet2") k = Worksheets("Sheet1").Range("A100010").End(xlUp).Row - 1 For dd = 3 To k Call aaa(Range("A" & dd)) Next dd Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub Private Sub aaa(ByVal Target As Range) Set wS = Worksheets("Sheet2") If Intersect(Target, Range("A:A")) Is Nothing Or Target.Count > 1 Then Exit Sub With Target If Not IsNumeric(.Value) Then Exit Sub If .Value Mod 1 = 0 Then Range("D1") = .Value For I = 1 To wS.Cells(Rows.Count, "A").End(xlUp).Row Do While Cells(Rows.Count, "D").End(xlUp) Mod wS.Cells(I, 1) = 0 cnt = cnt + 1 Cells(Rows.Count, "D").End(xlUp).Offset(1) = Cells(Rows.Count, "D").End(xlUp) / wS.Cells(I, 1) Loop If Cells(Rows.Count, "D").End(xlUp) = 1 Then Exit For Next I End If .Offset(, 1) = cnt End With Range("D:D").Clear End Sub 以前教えていただいたコードを使って書きました。 どういう状況で使っているかといいますと、シート1のA列に自然数を2から順番に並べ、シート2のA列に素数を並べておき、プログラムを実行すると、B列に素数の数が表示されるという具合です。 大変役に立っていたのですが、10萬ほどのデータを扱おうとすると、自分のコンピュータでは時間がかかりすぎます。そこでコードを改良して高速化をしたいのです。 いま考えられる改良点は、 1、D列を使って行っている処理をメモリで行うようにして、セルへのアクセスを省けないか 2、aaaの5行目の、"wS.Cells(Rows.Count, "A").End(xlUp).Row"この処理を簡単な変数の処理で代用できないか ということです。他にも高速化できる方法があれば教えてください。 よろしくお願いします。

専門家に質問してみよう