【先着1,000名様!】1,000円分をプレゼント!

下記のような表があって表の最終行に行を挿入したい場合にこのようなマクロを組んでみたのですが、思ったような動きをしてくれません。
アドバイスを頂けたらありがたいです。またこの場合名前の定義などを使う必要はあるのでしょうか。どうかよろしくお願いします。

   A    B    C    D   E   F

1 商品一覧
2 品名 売値 原価 利益
3 たい 1000 800 200
4 ひらめ 1200 800 400
5 かれい 1050 1200 -150
6 さわら 300 150 150
※ ここに行を挿入したい※  


Sub 行挿入() '表の最下行に行を挿入

Dim n As Long
n = Range("商品一覧").Rows.Count
Range("商品一覧").Cells(n, 1).EntireRow.Insert

End Sub

このQ&Aに関連する最新のQ&A

A 回答 (8件)

セル範囲を"商品一覧"という名前で定義されているのでしょうね?


定義されていなかったら、エラーですから...

Sub 行挿入() '表の最下行に行を挿入
Dim n As Long
n = Range("商品一覧").Rows.Count
Range("商品一覧").Cells(n, 1).EntireRow.Insert
End Sub

をそのまま使うとして、
セル"A1:A7"の範囲を"商品一覧"という名前定義したら、"A6"の下("A7"のところ)に一行入りました。
上記の定義範囲は、セル範囲が、A列の1行~7行なので...
それをカウントすると、n = 7 です。
なので、

> 商品一覧のすぐ下の行に挿入されてしまい求めているものができません。。
-------------------
これは、おそらく...
"A1"のみ名前定義されているので、Offset(1)しても、その下の行にしかOffsetしないので、
商品一覧のすぐ下の行に挿入されてしまうものと思われます。
("A1"のみだと、n = 1)

データの最終行に追加で挿入したいということであれば、merlionXX様、takana_様のご回答が、
ご希望のご回答のように思えますが、いかがでしょうか?

同じことをするにも、色々なやり方があるので、私も勉強になりました。
    • good
    • 0

「商品一覧」の範囲は正常に指定できていますでしょうか?


 n への代入後
Msgbox n として、nが正常か確認してください。(もしくはブレイクポイントとか使って)
例の場合なら1~6行目の6か、2~6行目の5ですよね?
それと、Cells(n, 1)ではなくCells(n+1, 1)ではありませんか?
Cells(n, 1)だと、さわらの上に行が挿入されそうな…?
    • good
    • 0

merlionXXさんも書かれているとおり、Range("商品一覧")の商品一覧の意味がわからないのですが、



6の下に1行追加するだけなら以下のマクロで出来ると思います。
Sub 行挿入() '表の最下行に行を挿入
   With Range("A1").CurrentRegion
    .Rows(.Rows.Count + 1).EntireRow.Insert
  End With
End Sub
    • good
    • 0

おっしゃることがよく理解できないのですが、お書きのデータの最下行(さわら)の下に行を挿入するのですか?


ということは、この表の下の方にもまだ何らかの入力されたセルがあるのですね?
そうでなければこの行の挿入はまったく無意味ですから。

そうだとしたら、end(xlUp)で下から探せませんので上から探すことになります。
表がA1から連続しているものとして

Cells(1, 1).End(xlDown).Offset(1).EntireRow.Insert

でいかがでしょうか?

あるいは、想像ですが、現在の表の範囲設定してある"商品一覧"という名前定義の範囲を一行下まで拡張したいという意味なのでしょうか?

だとしたら

Sub test01()
With Range("商品一覧")
Set myRng = .Resize(.Rows.Count + 1)
ActiveWorkbook.Names.Add Name:="商品一覧", RefersTo:=myRng
End With
End Sub

でどうでしょうか?
    • good
    • 0

>またこの場合名前の定義などを使う必要はあるのでしょうか。


 お示しの表内で「商品一覧」の範囲を
=Sheet1!$A$1:$D$6
としていらっしゃると存じますので、「6 さわら 300 150 150」の次の空白行も含めて
=Sheet1!$A$1:$D$7
として、「Sub 行挿入() '表の最下行に行を挿入」はそのままでお試しになってみてください。
    • good
    • 0

では、Offsetプロパティを外してみてください。



相対的なセルを参照する(Offsetプロパティ)
http://www.moug.net/tech/exvba/0050091.htm
    • good
    • 0

Range("商品一覧").Item(Range("商品一覧").Rows.Count).Offset(1).EntireRow.Insert



とか?
    • good
    • 0
この回答へのお礼

ありがとうございます。
ただ、やはりこれも商品一覧のすぐ下の行に挿入されてしまい求めているものができません。。

お礼日時:2009/03/15 18:08

なんか変な気がしますが



Sub 行挿入() '表の最下行に行を挿入
Dim n As Long
n = Range("商品一覧").Rows.Count
Range("商品一覧").Cells(n, 1).End(xlUp).Offset(1).EntireRow.Insert
End Sub
    • good
    • 1
この回答へのお礼

ありがとうございます。
ただ、商品一覧のすぐ下の行に挿入されてしまい求めているものができません。。

お礼日時:2009/03/15 18:08

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

QEXCEL 最終行に行を挿入(追加)する方法

EXCEL、WORD、PowerPointの行、列どれでも共通です。
行の挿入の際、最終行に挿入することはできないでしょうか?
この場合、“挿入”とは言わず、“追加”なのでしょうね。

最終行に追加できないので、割り込まれた行(最終行)の内容をひとつ前の空白の行にコピーし(安全のためです)、後から最終行の内容を削除することで回避しています。

面倒なので、即最終行に新規に行を設ける方法を教えてください

Aベストアンサー

バージョンによって多少違いますが、Word 2003の場合は、最終行を選択して、「罫線」メニュー→「挿入」→「行(下)」を選択するか、右クリックから「行の挿入」をクリックすると、行が追加されます。

または、「罫線」ツールバーの「表の挿入」ボタンを使用すると「表の挿入」を始めいろいろな挿入を指定できます。
 「Word(ワード)基本講座:列・行・セルの挿入/セルの分割」
 http://www.eurus.dti.ne.jp/~yoneyama/Word/w-hyou_retusounyu.htm

PowerPoint 2003の場合もWord 2003とほぼ同じ操作が可能です。

Excelの場合は、最終行の下には空白の行が連続していますので、改めて行の挿入を行う必要はありません。

QVBA 最終行に10行、行を挿入する作業。

VBA 最終行に10行、行を挿入する作業。
いつもお世話になっております。
上記の通りの質問をさせていただきたいです。
最終行は
With Range("A65536").End(xlUp).Offset(1)
End With
で取得できるのはわかります。でも挿入時には使えないらしく、
どうすればいいのか分かりません。
ちなみに最終行はその時によって代わります。
どうか宜しくお願い致します。

Aベストアンサー

>Range("A65536").End(xlUp).Offset(1)
Offset(1)していますから最終行の1行下になります。
下記で試してみてください。

With Range("H65536").End(xlUp)
.EntireRow.Resize(10).Insert shift:=xlDown
End With

QExcelのVBAで最終行の下にコピーする方法

ExcelのVBAについて勉強中です。

Excel2003で表から表への転記を行いたいのですが、
コードがうまく書けないため、教えていただきたいです。

やりたいこととしましては、
A1:D6のうちピンクの部分を、横一列に並べ替えながら、
F1:M6の色つきの部分(実際はより横に広くなります)に転記したいです。

ピンクの部分はその都度、値を変えて、
黄→緑→水色→青→紫・・・
と毎回マクロを実行するたびに最下行に追加できるような形にしたいです。

また、画像は同じシートに転記をしていますが、
別のシートの同様の表から同じように転記する場合、
どうコード変わるかも教えていただけましたら助かります。

自分では、下記のようなコードしか書けませんでした。
転記先の表は30列程度になる予定ですので、
出来ればシンプルなコードを教えていただきたいです。


Sub コピー()

Range("B2").Select
Selection.Copy
Range("G2").End(xlUp).Offset(1).Select
ActiveSheet.Paste

End sub


分かりづらい説明かと思いますが、
よろしくお願いします。

ExcelのVBAについて勉強中です。

Excel2003で表から表への転記を行いたいのですが、
コードがうまく書けないため、教えていただきたいです。

やりたいこととしましては、
A1:D6のうちピンクの部分を、横一列に並べ替えながら、
F1:M6の色つきの部分(実際はより横に広くなります)に転記したいです。

ピンクの部分はその都度、値を変えて、
黄→緑→水色→青→紫・・・
と毎回マクロを実行するたびに最下行に追加できるような形にしたいです。

また、画像は同じシートに転記をしていますが、
別のシートの同様の...続きを読む

Aベストアンサー

その程度の転写なら、あんまりカッコつけてやろうとせずに1個ずつ順番に転記してった方が、シンプルで間違いもありません。

sub macro1()
 dim h as range
 dim c as long
 dim LastRow as long

’貼り付け先行
 lastrow = worksheets("Sheet2").range("G65536").end(xlup).offset(1).row
’貼り付け先列
 c = 7 ’G列

 for each h in worksheets("Sheet1").range("B2:D6") ’コピー元
  worksheets("Sheet2").cells(lastrow, c).value = h.value
  c = c + 1 ’右の列に
 next
end sub

QVBA別シートの最終行の下行へ貼り付けされるようにしたいです。

教えてください。ド素人です。(参考書読み始めたところ)
聞き方も適切かわからないのですが、質問させてください。

Sheet1(入力画面)、Sheet2(確認画面)、Sheet3(データ)の3つのシートを作りました。

Sh1「入力画面」で入力された値は、関数で自動的に、Sh2「確認画面」指定のセルへコピーされるようにしています。
Sh1「入力画面」を入力し終えると。画面下のコマンドボタンで、Sh2「確認画面」へ画面が変わります。

そこで、内容を確認して、また、ここの下のコマンドボタンをクリックしてもらうと、Sh2「確認画面」の内容が、
Sh3(データ)の1行に集約されて貼り付けられます。同時にSh1「入力画面」の値は、クリアされ、Sh2「確認画面」も同様にクリアになります。

ここまで、完成したのですが、また、次のデータを入力していき、最後のSh3「データ」の最終行の下(空白行)に次々データを追加していくためのコードが解りません。

Sub ボタン3_Click()

Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim sh3 As Worksheet
Set sh1 = Worksheets("入力画面")
Set sh2 = Worksheets("確認画面")
Set sh3 = Worksheets("データ")

With sh2
.Range("C2:E2").Copy
Sheets("データ").Range("B2:D2").PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, False, False
.Range("C3:C5").Copy
Sheets("データ").Range("E2:G2").PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, False, True
.Range("C6:D6").Copy
Sheets("データ").Range("H2:I2").PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, False, False
.Range("C7:D7").Copy
Sheets("データ").Range("J2:K2").PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, False, False
.Range("C8:D8").Copy
Sheets("データ").Range("L2:M2").PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, False, False
.Range("C9:D9").Copy
Sheets("データ").Range("N2:O2").PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, False, False
.Range("C10:C14").Copy
Sheets("データ").Range("P2:T2").PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, False, True
.Range("C17").Copy
Sheets("データ").Range("U2").PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, False, False
End With

With sh1
.Range("D8:K8").ClearContents
.Range("D6:K6").ClearContents
.Range("D4:K4").ClearContents
.Range("D10:K10").ClearContents
.Range("D12:J12").ClearContents
.Range("D14:L14").ClearContents
.Range("L16").ClearContents
.Range("D16:J16").ClearContents
.Range("D18:J18").ClearContents
.Range("L18").ClearContents
.Range("L20").ClearContents
.Range("D20:J20").ClearContents
.Range("L22").ClearContents
.Range("D22:J22").ClearContents
.Range("D24:H24").ClearContents
.Range("D26:H26").Value = "90"
.Range("D28:H28").Value = "80"
.Range("D30:H30").Value = "5"
.Range("D32:H32").Value = "5"
End With
Worksheets("入力画面").Activate
End Sub

ここまで、試行錯誤した内容です。
どこに最終行の下(空白行)の記述をいれられますでしょうか?
画像が一枚しかのせられなかったので、Sheet2(確認画面)だけ添付致しました。
Sheet3(データ)では、一行に集約しています。
是非、ご教授お願いします。色々なお意見がききたいです。

教えてください。ド素人です。(参考書読み始めたところ)
聞き方も適切かわからないのですが、質問させてください。

Sheet1(入力画面)、Sheet2(確認画面)、Sheet3(データ)の3つのシートを作りました。

Sh1「入力画面」で入力された値は、関数で自動的に、Sh2「確認画面」指定のセルへコピーされるようにしています。
Sh1「入力画面」を入力し終えると。画面下のコマンドボタンで、Sh2「確認画面」へ画面が変わります。

そこで、内容を確認して、また、ここの下のコマンドボタンをクリックして...続きを読む

Aベストアンサー

私も、ど素人のマクロで、オマケにどんどん今は劣化中です。
ただ、今は、もう参考にする本もなくなってしまいました。

ご質問は、非常にわかりやすいです。

必ず、起点が2行目にあるとすれば、
i = sh3.Cells(Rows.Count, 2).End(xlUp).Row -1 '最後の次の行を探します。

そこに、Offsetで、ずらしていきます。

Sheets("データ").Range("B2:D2").Offset(i).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, False, False
のようにして、全部、置換で、.Offset(i). を割りこませればよいでしょう。
検索:[).P] -> 置換:[).Offset(i).P]

以下で、添付したのは、マクロを集約してしまいました。
たぶん、私のコードは参考にはなりません。こんな考え方もあるのかなっていう程度にしてください。以下は、機械的に作られたものです。

'//--
Sub Test2Macro()
  Dim sh1 As Worksheet: Set sh1 = Worksheets("入力画面")
  Dim sh2 As Worksheet: Set sh2 = Worksheets("確認画面")
  Dim sh3 As Worksheet: Set sh3 = Worksheets("データ")
  Dim r1 As Range, a As Range
  Dim i As Long, j As Long, k As Long
  Dim Datas As Variant, c As Variant
  
  j = sh3.Cells(Rows.Count, 2).End(xlUp).Row + 1 '最後の行を探します。
  Set r1 = sh2.Range("C2:E2,C3:C5,C6:D9,C10:C14, C17")
  i = 2 '初期列
  For Each c In r1.Cells
    sh3.Cells(j, i).Value = c.Value
    i = i + 1
  Next c
  
  sh1.Range("D6:K6,D8:K8,D4:K4,D10:K10,D12:J12" & _
  ",D14:L14,L16,D16:J16,D18:J18,L18,L20" & _
  ",D20:J20,L22,D22:J22").ClearContents
  Datas = Array(90, 80, 5, 5)
  For Each a In sh1.Range("D26:H26,D28:H28,D30:H30,D32:H32").Areas
    a.Value = Datas(k)
    k = k + 1
  Next a
End Sub
'//--

私も、ど素人のマクロで、オマケにどんどん今は劣化中です。
ただ、今は、もう参考にする本もなくなってしまいました。

ご質問は、非常にわかりやすいです。

必ず、起点が2行目にあるとすれば、
i = sh3.Cells(Rows.Count, 2).End(xlUp).Row -1 '最後の次の行を探します。

そこに、Offsetで、ずらしていきます。

Sheets("データ").Range("B2:D2").Offset(i).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, False, False
のようにして、全部、置換で、.Offset(i). を割りこませればよいでしょう。...続きを読む

QVBAで行コピーして挿入

1行目の内容をコピーして、他の場所に指定数分だけ
挿入するマクロを作りました。

そのマクロ自体は、正しく動いたのですが、コピー元の1行目に
他のシートを参照する関数が入っていた場合、想定どおりの
結果を得ることができません。

[SHEET1:データのみを記載]
省略

[SHEET2]
A1セル:   =SHEET1!$A1 ←コピー元の行

[マクロ:一部抜粋]
myR = Application.InputBox("挿入する行数を入れてください", , "1")

For i = 1 To myR
  Rows("1:1").Copy
  Cells(ActiveCell.Row, 1).Select
  Selection.Insert Shift:=xlDown
  Selection.EntireRow.Hidden = False
Next i

どういう結果を求めたいかというと、たとえば、
SHEET2のA10セル上で、このマクロを実行し、 "挿入行 = 3" と指定したら

A10:   =SHEET1!$A10
A11:   =SHEET1!$A11
A12:   =SHEET1!$A12

となってほしかったのですが、結果は、

A10:   =SHEET1!$A10
A11:   =SHEET1!$A10
A12:   =SHEET1!$A10

となってしまいました。

どうにか、求める結果を得られるようにできないでしょうか?

1行目の内容をコピーして、他の場所に指定数分だけ
挿入するマクロを作りました。

そのマクロ自体は、正しく動いたのですが、コピー元の1行目に
他のシートを参照する関数が入っていた場合、想定どおりの
結果を得ることができません。

[SHEET1:データのみを記載]
省略

[SHEET2]
A1セル:   =SHEET1!$A1 ←コピー元の行

[マクロ:一部抜粋]
myR = Application.InputBox("挿入する行数を入れてください", , "1")

For i = 1 To myR
  Rows("1:1").Copy
  Cells(ActiveCell.Row, 1).S...続きを読む

Aベストアンサー

Active.Cellが同一の位置なのだから相対変位しません。

一例です。(ループは不要なので削除しました)
myR = Application.InputBox("挿入する行数を入れてください", , "1")
Rows("1:1").Copy
Rows(ActiveCell.Row & ":" & ActiveCell.Row + myR - 1).Select
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False

QExel VBA 別ブックから該当データを検索し、必要なデータを取得する方法について

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数ではなく、マクロで処理を希望します。

自分では、部品表の商品番号をコピーして、コード一覧表で検索し、検索結果の右隣のセル(B列のコード)の値を部品表のC列に貼り付ければよいかと思い、書いてみたんですが…

Sub 別ブックから貼り付ける()
  Dim 検索する As Long
Windows("部品表.xls").Activate
検索する = cells(i,2).Value
Windows("コード一覧表.xls").Activate
ActiveWindow.SmallScroll Down:=-3
Selection.AutoFilter Field:=3, Criteria1:="=検索する", Operator:= xlAnd

と、してみたものの、検索しても、その検索結果の隣のセルのコードをどうやって取得すればいいのかが、わかりませんでした。

基本事項は本で学びましたが、呪文のようなコードはよく理解できません。懸命にネットで検索して、訳して理解する努力をしてはいますが。

どうぞよろしくお願いします。

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数...続きを読む

Aベストアンサー

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks.Open("C:\★★\コード一覧表.xls") '★要変更★
 I = 2
 Do While Range("A" & I).Value <> ""
  ThisWorkbook.Worksheets("Sheet1").Range("C" & I).Value = Application.VLookup(ThisWorkbook.Worksheets("Sheet1").Range("B" & I).Value, xlBook.Worksheets("Sheet1").Range("A2:B65535"), 2, 0)
  I = I + 1
 Loop
 xlBook.Close
 Application.ScreenUpdating = True
 MsgBox ("完了")
End Sub

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks....続きを読む

Q別のシートから値を取得するとき

Worksheets("シート名").Activate
上記のを行ってから別シートの値を取得するのですが、
この処理を行うと指定したシートへ強制的にとんでしまいます。。。

※イメージ
For ~ To ~
  Worksheets("シートA").Activate
  シートAの値取得
       :
  Worksheets("シートB").Activate
  シートBの値取得
Next

このイメージ処理を行うとものすごい勢いで画面がチカチカします。。。
シートを変えずに他のシートから値を取得する方法はないのでしょうか。
教えてください!

Aベストアンサー

Worksheets("シートA").Range("A1")

みたいな感じでできませんか?

QEXCEL VBA 条件による行の自動挿入

お世話になります。

EXCEL VBAを使用して自動で行の挿入処理を実施したいと思っております。

やりたい事は添付図の表1を処理ボタンを押せば自動で表2のようにしたいのです。
表2の黄色部分が自動挿入させたい部分です。


例えば「表2作成」というボタンを押したら・・

[sheet1]にある表1をC1からC??の最終行までREADしてC??の文字列が
[定価番販売実績]であれば・・
(1)[定価販売実績]の上の行に[定価販売予定]という行を挿入
(2)[定価販売実績]の下の行に[定価差異]という行を挿入

[得売販売実績]であれば・・
(3)[特売販売実績]の上の行に[特売販売予定]という行を挿入
(4)[特売販売実績]の下の行に[特売差異]という行を挿入

という作業を全商品に対して実施したいのです。
図では3商品ですが実際には変動ですが100~200品位です。

出来上がった新しい表2は別シートに表示できれば最高です!

どなたか方法をご教授いただけませんでしょうか?
よろしくお願い致します。

環境
Windows XP SP3
EXCEL2003

お世話になります。

EXCEL VBAを使用して自動で行の挿入処理を実施したいと思っております。

やりたい事は添付図の表1を処理ボタンを押せば自動で表2のようにしたいのです。
表2の黄色部分が自動挿入させたい部分です。


例えば「表2作成」というボタンを押したら・・

[sheet1]にある表1をC1からC??の最終行までREADしてC??の文字列が
[定価番販売実績]であれば・・
(1)[定価販売実績]の上の行に[定価販売予定]という行を挿入
(2)[定価販売実績]の下の行に[定価差異]という行を挿入

[得売販売実績]であれば・...続きを読む

Aベストアンサー

こんばんは!
VBAでの一例です。
画像通り1行目は項目行で、データは2行目以降にあるとします。
画像を拝見するとA列は結合してあるようですね!

>処理ボタンを押せば自動で・・・
とありますので、操作したいSheetにコマンドボタンを配置するとします。
↓のコードをコピー&ペーストしてコマンドボタンをクリックしてみてください。
コマンドボタンでなくても
メニュー → 挿入 → オートシェイプ → 挿入したオートシェイプ上で右クリック → マクロの登録 → 新規作成
このVBE画面でも構いません

Private Sub CommandButton1_Click() 'この行から
Dim i As Long, k As Long
Range("A:A").UnMerge
For i = 2 To Cells(Rows.Count, 2).End(xlUp).Row
If Cells(i, 1) = "" Then
Cells(i, 1) = Cells(i - 1, 1)
End If
Next i
For i = Cells(Rows.Count, 2).End(xlUp).Row To 2 Step -1
If Cells(i, 3) = "定価販売実績" Then
Rows(i + 1).Insert
Cells(i + 1, 3) = "定価販売差異"
Cells(i + 1, 1) = Cells(i, 1)
Rows(i).Insert
Cells(i, 3) = "定価販売予定"
Cells(i, 1) = Cells(i + 1, 1)
ElseIf Cells(i, 3) = "特売販売実績" Then
Rows(i + 1).Insert
Cells(i + 1, 3) = "特売販売差異"
Cells(i + 1, 1) = Cells(i, 1)
Rows(i).Insert
Cells(i, 3) = "特売販売予定"
Cells(i, 1) = Cells(i + 1, 1)
End If
Next i
Application.DisplayAlerts = False
For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
If Cells(i, 1) = Cells(i - 1, 1) Then
Range(Cells(i - 1, 1), Cells(i, 1)).Merge
End If
Next i
Application.DisplayAlerts = True
End Sub 'この行まで

※ 1行目と最終行は
コマンドボタンを挿入 → 挿入したコマンドボタン上でダブルクリックすると自動で表示されますので、
ダブらないようにコードをコピー&ペーストしてみてください。

尚、一旦コマンドボタンをクリックすると元に戻せませんので
別Sheetで試してみてくだい。m(_ _)m

こんばんは!
VBAでの一例です。
画像通り1行目は項目行で、データは2行目以降にあるとします。
画像を拝見するとA列は結合してあるようですね!

>処理ボタンを押せば自動で・・・
とありますので、操作したいSheetにコマンドボタンを配置するとします。
↓のコードをコピー&ペーストしてコマンドボタンをクリックしてみてください。
コマンドボタンでなくても
メニュー → 挿入 → オートシェイプ → 挿入したオートシェイプ上で右クリック → マクロの登録 → 新規作成
このVBE画面でも構いません

Priva...続きを読む

Qエクセル最終行の下に貼り付け

VBAで以下の作業を教えて下さい。

Sheet1のB列に入力済みのセルが何行かあります。
その入力済みのセルの値をコピーして、Sheet2のA列の入力済みの最終行のすぐ下の行に貼り付ける。

*Sheet1のB列の入力済みのセルの行数は毎回変わります。
*Sheet2のA列には一番最初は何も入力されていない状態です。

宜しくお願い致します。

Aベストアンサー

No.1です!
補足を読ませていただきました。

Sheet1のB・C列をSheet2のA・B列の最終行以降に!ということなので・・・

おそらくSheet1のB・C列の行数(データ量)が違うのが普通だと思いますので、
2列を範囲指定 → Sheet2のA列もしくはB列の最終行以降に貼り付け!という操作では
空白セルが出来てしまうと思います。
もちろんそれを削除するコードを作れば良いのですが、今回は2列だけだというコトですので
単純に前回の操作を2回繰り返すコードにしてみました。

Sub test2()
Dim i, j As Long
Dim ws1, ws2 As Worksheet
Set ws1 = Worksheets("sheet1")
Set ws2 = Worksheets("sheet2")
i = ws1.Cells(Rows.Count, 2).End(xlUp).Row
j = ws1.Cells(Rows.Count, 3).End(xlUp).Row
Range(ws1.Cells(2, 2), ws1.Cells(i, 2)).Copy
ws2.Activate
ws2.Cells(Rows.Count, 1).End(xlUp).Offset(1).Select
ActiveSheet.Paste
Range(ws1.Cells(2, 3), ws1.Cells(j, 3)).Copy
ws2.Activate
ws2.Cells(Rows.Count, 2).End(xlUp).Offset(1).Select
ActiveSheet.Paste
Application.CutCopyMode = False
ws2.Cells(Rows.Count, 1).End(xlUp).Offset(1).Select
End Sub

こんな感じではどうでしょうか?

※ じっくり考えればもっと良い方法があるかもしれません。
この程度でごめんなさいね。m(_ _)m

No.1です!
補足を読ませていただきました。

Sheet1のB・C列をSheet2のA・B列の最終行以降に!ということなので・・・

おそらくSheet1のB・C列の行数(データ量)が違うのが普通だと思いますので、
2列を範囲指定 → Sheet2のA列もしくはB列の最終行以降に貼り付け!という操作では
空白セルが出来てしまうと思います。
もちろんそれを削除するコードを作れば良いのですが、今回は2列だけだというコトですので
単純に前回の操作を2回繰り返すコードにしてみました。

Sub test2()
Dim i, j As Long
Dim...続きを読む

Q[初心者です]VBAで指定列からAを検索し、発見したら隣のセルに値0を入れるマクロ。

VBAで指定列からAを検索し、発見したら隣のセルに0を入れるマクロを組みたいのですが、組み方がVBA初心者の為わかりません。
(例)
L列に、A、B、C、D、E、Fとランダムに文字が入っていて、
文字Aを検索し、発見したら隣のI列に値0を入れるというマクロです。

Sub Search()
Dim A As String
Set A = Worksheets("Sheet1").Cells.Find("A")
If A Is Nothing Then
ActiveCell.Offset(0, 1).Value = 0

End If
End Sub
と過去の質問で考えてみたのですが、Aがあった時、、、、
とコードが書けないです。
大変困っているので、ご教授頂けないでしょうか?
出来れば、そのままマクロに出来るコードを教えて頂けないでしょうか?
宜しくお願い致します。

Aベストアンサー

こんばんは。

#3さんのおっしゃっていることも、もっともなのですが、気になる点がありましたので、自分のことを踏まえて、書かせていただきます。

いずれ、また、同じようなケースが出会うと思います。こんな原則を考えてみたらどうでしょうか?それは、私も自身も同じなのですが、ワークシートのコマンドで行われるものは、記録マクロから作ってみるということです。他にも、「統合」とか、「置換」とか「オートフィルタ」「フィルタオプション」とかは、みんなパターンが決まっています。
その中の代表格が、この「Find」 です。

>Set A = Worksheets("Sheet1").Cells.Find("A")

>過去の質問で考えてみたのです

どうも、Find メソッドは、あるレベル以下の人は、省略する傾向があるようです。何が大事で、何が大事でないかというのは、やってみなければ分かりませんが、検索語だけを入れる書き方は、実務では、あまりしないほうがよいと思います。

だいたい、以下のTestFind2 ぐらいまでに、省略は、とどめたほうがよいです。

それは、Find は、必ずしも自分が思っているデフォルトとは違うことがあるので、「明示的(意図的に)」にオプションは入れたほうがよいです。
例えば、大文字小文字の違いを付けるなら、MatchCase:=True, 数式まで探すなら、LookIn:=xlFormulas

なお、Find メソッドは、5年経っても、たぶん完全に覚えられません。面倒なコードのひとつです。ですが、これはパターンが決まっているので、ひとつパターンが決まったら、それに当てはめればよいだけです。

#3さんで示されているMougのサンプルコードと似てはいるのですが、Mougのサンプルコードでは、Verionによって、失敗することがあります。

'--------------------------------------
'記録マクロをそのまま使う方法
Sub TestFind1()
Dim c As Range
 Set c = Columns("L:L").Find(What:="A", _
           After:=ActiveCell, _
           LookIn:=xlValues, _
           LookAt:=xlPart, _
           SearchOrder:=xlByRows, _
           SearchDirection:=xlNext, _
           MatchCase:=False, _
           MatchByte:=False, _
           SearchFormat:=False)
 c.Offset(0, 1).Value = 0
End Sub
'--------------------------------------
'TestFind1 をアレンジしてみる
Sub TestFind2()
Dim c As Range
'検索語
Const MYTXT As String = "A"
 Set c = ActiveSheet.Columns("L:L").Find(What:=MYTXT, _
           LookIn:=xlValues, _
           LookAt:=xlPart, _
           MatchCase:=False)
 If Not c Is Nothing Then
    c.Offset(0, 1).Value = 0
 End If
End Sub

'---------------------------------------
'複数ある場合(パターンを使った方法)
'---------------------------------------
Sub TestFind3()
  Dim c As Range
  Dim FirstAdd As String
  Const MYTXT As String = "A"
  Set c = ActiveSheet.Columns("L:L").Find( _
    What:=MYTXT, _
    LookIn:=xlValues, _
    LookAt:=xlPart, _
    MatchCase:=False)
  
  If Not c Is Nothing Then
    FirstAdd = c.Address
    Do
      c.Offset(, 1).Value = 0
      Set c = ActiveSheet.Columns("L:L").FindNext(c)
      If c.Address = FirstAdd Then Exit Sub
    Loop Until c Is Nothing
  End If
End Sub

こんばんは。

#3さんのおっしゃっていることも、もっともなのですが、気になる点がありましたので、自分のことを踏まえて、書かせていただきます。

いずれ、また、同じようなケースが出会うと思います。こんな原則を考えてみたらどうでしょうか?それは、私も自身も同じなのですが、ワークシートのコマンドで行われるものは、記録マクロから作ってみるということです。他にも、「統合」とか、「置換」とか「オートフィルタ」「フィルタオプション」とかは、みんなパターンが決まっています。
その中の代表...続きを読む


このQ&Aを見た人がよく見るQ&A

このカテゴリの人気Q&Aランキング