今だけ人気マンガ100円レンタル特集♪

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

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(データ)では、一行に集約しています。
是非、ご教授お願いします。色々なお意見がききたいです。

「VBA別シートの最終行の下行へ貼り付けさ」の質問画像

A 回答 (4件)

私も、ど素人のマクロで、オマケにどんどん今は劣化中です。


ただ、今は、もう参考にする本もなくなってしまいました。

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

必ず、起点が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
'//--
    • good
    • 0
この回答へのお礼

WindFaller様、詳しく説明を頂き有難うございます。

Offsetとか、For~Nextの使い方がいまいちわからなかったんですよね~。
参考にさせて頂きます。集約して、短いコードが書けたら、かっこいいですものね。

試してみてまた、報告を書きます。

お礼日時:2016/04/08 19:48

ついでに


>.Range("C2:E2").Copy
>Sheets("データ").Range("B2:D2").PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, False, False
コピーと貼付けの繰り返しですが、データですので値だけで十分ですよね。
sh3.Range("B2:D2").Value=.Range("C2:E2").Value
と1行ですませます。もちろんパソコンの負担は絶対的に軽くなります。

データシートの最終行番号は
i = sh3.Cells(Rows.Count, 2).End(xlUp).Row+1
して取得します。
Rows.Countはシートの持つ最大の行数で
エクセル2007以上であれば、1048576行です。
B列の1048576行から上へ移動して空白でない行と云うのが
sh3.Cells(Rows.Count, 2).End(xlUp).Row
その一つ下の行番号ですので +1  ですね。

もう一つのテクニックですが、入力画面の1行目に行を挿入して
   A      B          C  D
1 =Today() =Max(データ!A:A)+1 =C2 =D2・・・・・
データが一行に表示されるように関数を入れておきます。
参考までに A1に日付、B1には、データの管理番号が並ぶようしています。
目障りなら、1行目を非表示にしておきます。

VBAのコードは
Dim sh2 As Worksheet
Dim sh3 As Worksheet
Dim i As Long
Set sh2 = Worksheets("確認画面")
Set sh3 = Worksheets("データ")
i = sh3.Cells(Rows.Count, 2).End(xlUp).Row+1
sh3.Range("A" & i & ":U" & i).Value = Rnage("A2:U2").Value
後は、ClearContentsの部分

と云ったように10数行ほど完成する内容です。
関数などの機能と組み合わせることで
コードをシンプルにしておくと後々のメンテナンスも楽になります。
コピーと貼付けもむやみに使わない事です。
    • good
    • 1
この回答へのお礼

hallo-2007さま、詳しい解説有難うございます。
なるほど、なるべくシンプルなコードにする工夫が、もっと必要ですね。
大変参考になります。
色々試させていただきたいと思います。

お礼日時:2016/04/09 23:00

No.1です、お礼ありがとうございます。



>i = sh3.Range("B65530").End(xlDown).Row + 1
>この構文の”B65530”が表している範囲が、よくわかりません。
これは単純にデータが被らないように大きい数字を当てているだけでして、
数字の範囲には大きな意味はありません。
例えば、貼り付けるデータの上限が1000であれば、
上記のBの値を1000に変えていただいても処理自体は変わりません。
    • good
    • 1

一応確認ですが、貼り付けるデータは必ず数値または文字列が入っているものということでよろしいでしょうか。


もし必ずデータが入っているというのであれば、データシートの一番下の行を取得し、
確認画面シートのデータを貼り付けるところで行の位置をずらせば可能ではないでしょうか。

質問内容のソースをそのまま使用しますと、

Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim sh3 As Worksheet
Dim i As Integer '追加部分、データシートの一番下の行を格納する変数
Set sh1 = Worksheets("入力画面")
Set sh2 = Worksheets("確認画面")
Set sh3 = Worksheets("データ")

'データシートの一番下の行を取得(B列にデータが必ずあるものとして記載してます)
i = sh3.Range("B65530").End(xlDown).Row + 1

と追加したら、次にデータシートの貼り付け位置の数値部分を変数で結合するようにします。

With sh2
.Range("C2:E2").Copy
sh3.Range("B" & i & ":D" & i).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, False, False
.Range("C3:C5").Copy
sh3.Range("E" & i & ":G" & i).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, False, True
以下省略

そして最後に入力画面のシートを初期化する処理を持ってくればできるかと思います。

With sh1
.Range("D8:K8").ClearContents
.Range("D6:K6").ClearContents
以下省略

参考程度にどうぞ。
    • good
    • 1
この回答へのお礼

ごまふあざらし様、詳しく説明頂いて有難うございます。

> 一応確認ですが、貼り付けるデータは必ず数値または文字列が入っているものということでよろしいでしょうか。
  →はい、貼り付けるデータには必ず値が入っている状態になります。
>i = sh3.Range("B65530").End(xlDown).Row + 1
  この構文の”B65530”が表している範囲が、よくわかりません。すみません。
  取り敢えず、来週会社に行ってから、試してみます。(自宅のパソコンにはExcelが入ってないので・・・)

お礼日時:2016/04/08 19:11

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

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

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

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

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

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エクセル最終行の下に貼り付け

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別のシートから値を取得するとき

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

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

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

Aベストアンサー

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

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

QエクセルVBA 別シートの複数のセルの値をコピーする方法

いつもお世話になります。

Dim sh1, sh2 As Worksheet
Set sh1 = Worksheets("sheet1")
Set sh2 = Worksheets("sheet2")

sh1.Range("C6").Value = sh2.Range("F5").Value
として、1つのセルの値ならコピーできるのですが、
sh1.Range("C6:C10").Value = sh2.Range("F5;F9").Value
としても、セルの値を持ってくることができません。
どのように書けば良いのでしょうか?

ちなみに今は、
sh2.Range("F5:F9").Copy
sh1.Range("C5:C9").PasteSpecial Paste:=xlValues
としているのですが、上記だとセルを範囲指定してしまって作業が見えるのでカッコ悪いのです。

Aベストアンサー

7-samuraiの質問ですみません。
No5のimogasiさん、いつもお世話様です。

Sub test01()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Set sh1 = Worksheets("sheet2")
Set sh2 = Worksheets("sheet1")
sh1.Range("c1:c5").Value = sh2.Range("A1:A5").Value
End Sub

で、うまくいきますよ。
複数セルの場合Valueは省略できないようです。

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さんのおっしゃっていることも、もっともなのですが、気になる点がありましたので、自分のことを踏まえて、書かせていただきます。

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

QExcelVBAを使って、値がある場合は作業を繰り返し実行するプログラムを作成したい。

以下のようなプログラムをVBAで作成したいと考えています。

A1のセルに値があれば、その値をB1に返す。
次にA2のセルに値があれば、その値をB2に返す。
A行に値がある一番下のセルまで同じようなことをさせたいと考えています。

VBAは初心者です。
どなかた宜しくお願い致します。

Aベストアンサー

#2さんと似たものですが・・・・参考にしてください。

Sub test001()
Dim i As Long
i = 1
Do While Cells(i, 1) <> ""
Cells(i, 2) = Cells(i, 1)
i = i + 1
Loop
End Sub

Qエクセルで、条件に一致した行を別のセルに抜き出す方法

エクセルで、指定した条件に一致するセルを含む行をすべて抜き出す方法が知りたいです。

たとえば、

<A列> <B列> <C列>
7/1 りんご 100円
7/2 ぶどう 200円
7/2 すいか 300円
7/3 みかん 100円

このような表があって、100円を含む行をそのままの形で、
別のセル(同じシート内)に抜き出したいのですが。

7/1 りんご 100円
7/3 みかん 100円

抽出するだけならオートフィルターでもできますが、
抽出結果を自動的に、別の場所に、常に表示させておきたいのです。

初歩的な質問だと思いますが、検索しても分からなかったので、よろしくお願いします。

Aベストアンサー

同じ質問が結構よく出てますが、そんなに初歩的でもありません
別シートのA1セルに「100円」と入力し、そのシートの任意のセルに以下の式を貼り付けて下さい。後は、下方向、右方向にコピー。
日付のセル書式は「日付」形式に再設定してください

=IF(COUNTIF(Sheet1!$C:$C,$A$1)>=ROW(A1),INDEX(Sheet1!A:A,LARGE(INDEX((Sheet1!$C$1:$C$500=$A$1)*ROW(Sheet1!$C$1:$C$500),),COUNTIF(Sheet1!$C:$C,$A$1)-ROW(A1)+1)),"")

データ範囲は500行までとしていますが、必要に応じて変更して下さい

Qある範囲のセルから任意の値を検索して、その隣のセルの値を取得するという関数はありますか?

Excelの関数について質問します。
ある範囲のせるを検索して、その隣のセルの値を取得するという関数を探しています。
なければユーザー定義で作りたいと思っています。
VLOOKUP関数では一番左端が検索されますが、
それをある範囲まで拡張して、
その右隣の値を取得できるようにしたいのです。
どうかお知恵をお貸しください。

Aベストアンサー

●X1セルの値を範囲A1:F200の中から探して、その右隣のセルの値を返す

 =OFFSET(A1,SUMPRODUCT(ROW(A1:F200)*(A1:F200=X1))-1,SUMPRODUCT(COLUMN(A1:F200)*(A1:F200=X1)))

※最初のA1はワークシートの左上隅を示すものなので、検索範囲に関わらずA1固定
※SUMPRODUCT(ROW(A1:F200)*(A1:F200=X1)) ⇒ A1:F200で値がX1と一致するセルの行番号

>その「ある範囲」の中には検索したい値が入っているセルは1つしかありません。
というのが前提です。複数のセルがHITすると関係ないセルの値が返るので、
場合によっては、IFをかぶせてCOUNTIFで確認した方が良いかもしれません。
 ex. =IF(COUNTIF(A1:F200,X1)=1,【上記数式】,"えらー")

ちなみに、VBAでやるならこんな感じになるかと。

動作の概要
 【検査範囲】から【検査値】を探し、
 最初にHITしたセルについて、右隣のセルの値を返す。
 ex. =Sample(X1,A1:F200)

'--------------------------↓ココカラ↓--------------------------
Function Sample(ByVal 検査値 As Variant,ByVal 検査範囲 As Range)
 For Each セル In 検査範囲
  If セル = 検査値 Then Exit For
 Next セル
 Sample = セル.Offset(0, 1)
End Function
'--------------------------↑ココマデ↑--------------------------

いずれもExcel2003で動作確認済。
以上ご参考まで。

●X1セルの値を範囲A1:F200の中から探して、その右隣のセルの値を返す

 =OFFSET(A1,SUMPRODUCT(ROW(A1:F200)*(A1:F200=X1))-1,SUMPRODUCT(COLUMN(A1:F200)*(A1:F200=X1)))

※最初のA1はワークシートの左上隅を示すものなので、検索範囲に関わらずA1固定
※SUMPRODUCT(ROW(A1:F200)*(A1:F200=X1)) ⇒ A1:F200で値がX1と一致するセルの行番号

>その「ある範囲」の中には検索したい値が入っているセルは1つしかありません。
というのが前提です。複数のセルがHITすると関係ないセルの値が返るので、
場...続きを読む

Q指定した文字があった場合、その行を削除するマクロが欲しいです

指定した文字があった場合、その行を削除するマクロが欲しいです
Sheet1(Sheet1以外は対象外)のB列に
XYZ
という文字があった場合、その行をすべて削除する
というマクロはどのように作ればいいでしょうか?
お時間ある方アドバイスいただければ幸いです。

Aベストアンサー

手抜きですがこんな感じでどうでしょう。
削除する行が多いなら画面更新を停止した方が良いでしょう。

Sub Sample()
 Sheets("Sheet1").Select
 Do While (True)
  Columns("B:B").Select
  Set mySelect = Selection.Find(What:="XYZ")
  If mySelect Is Nothing Then Exit Do
  Rows(mySelect.Row).Select
  Selection.Delete Shift:=xlUp
 Loop
End Sub


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

人気Q&Aランキング