はじめての親子ハイキングに挑戦!! >>

Excel2010の「ホーム」タブの「編集」グループより「検索と選択」の「検索」で住所録の「名前」を検索しています。
「検索する文字列」に「名前」を入力して「すべて検索」をクリックすると検索結果がでますが、検索結果の表示方法が「セル番地」だけを表示しているため一つ一つそのセルをクリックして内容を確認しています。
これを検索された複数のデータを住所録一覧表の項目名に合わせてまとめて別シートにコピーしたいのですが・・・。

Sheet1に次の項目名で住所録を作成しています。
A列:会社名
B列:名前
C列:住所
D列:電話番号

「名前」で検索して、検索されたデータのA列からD列までのデータを別シート(Sheet2)の同じ表にコピーしたいのです。
名字だけの検索ですので結果が複数ある場合は、すべての検索結果を数行にわたってコピーできればいいのですが・・・。

このメニューのコマンドを使わなくても、何か他の方法でVBAの例があれば教えていただきたいと思います。

宜しくお願いします。

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

A 回答 (2件)

結論から言うとわざわざマクロなど使わずとも。



推奨:
データタブの「オートフィルタ」を取り付け、「テキストフィルタ」から「指定の値を含む」(あるいは等しい、始まる等)で名前を記入して絞り込み、まとめて選んでコピー貼り付ければ完成です。



それとも。
とにかく操作をしたくないのでマクロをどうしても使いたい、というご相談なら。

作成例:
sub macro1()
 dim s as string
 s = inputbox("NAME?")
 if s = "FALSE" then exit sub

 application.screenupdating = false
 worksheets("Sheet2").cells.clearcontents
 with worksheets("Sheet1")
  .autofiltermode = false
  .range("A:D").autofilter field:=2, criteria1:=s & "*"
  .range("A:D").copy destination:=worksheets("Sheet2").range("A1")
  .autofiltermode = false
 end with
 application.screenupdating = true
end sub



一応念のため:
手を動かして操作したほうが、たとえば「どこにどんな具合に貼り付けたい」とかその時々の状況に応じて機動的に作業できますので、結果的には仕事は早いと思いますよ?
    • good
    • 0
この回答へのお礼

早速のお返事ありがとうございます。
「オートフィルタ」の方法を使ってみることにしました。
仰る通り、少ないデータの場合は手作業で「コピー」‐「貼り付け」の方が早いですね。
でも、VBAも勉強したいので回答を頂いたコードを使って試したいと思います。
ありがとうございました。

お礼日時:2012/07/26 00:08

手作業をVBAとして記述してくれる「マクロの記録」機能を利用してみては?



冗長な部分が多々ありますが、何をしているか見ることができますよ。
    • good
    • 0
この回答へのお礼

早速のお返事ありがとうございます。
「マクロの記録」を使ったのですが「次を検索」ボタンではマクロの記録が記述されるのですが「すべて検索」のボタンでは何も記録されません。

Sub Macro1()

End Sub

の表示だけで中身がありません。
動作上では確認できるのですが、コードが記述されないため役に立ちませんでした。

お礼日時:2012/07/26 00:01

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

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

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

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

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

QExcel内での検索結果をシートに出力したい

こんばんは。いつも大変お世話になっています。

Excel2003にて、あるシートの中から
対象の文字列があるかどうか検索をしました。
検索時に「すべて検索」にすると、
全結果が表示されますよね。
その内容をExcelのシートに出力することは
できないでしょうか・・・。

どのセルの位置にその対象文字列がいてということを
報告書として作成したいのです。

イメージがうまくかけませんが、どなたかよい方法を
ご存知でしたら教えてください。
何か記述で足りないものがあれば、すぐに記述いたします。

Aベストアンサー

丸投げですか(^^;
以下のマクロをALT+F11でVBE画面を開き、左上のVBA Projectでシート名を右クリックし「挿入」→「標準モジュール」で表示される画面に貼り付けて下さい。マクロの実行はワークシート画面に戻ってALT+F8でマクロ一覧を開き、マクロ名を選択して「実行」ボタンです。

勉強になりませんので解説や再修正はしません。もし修正が必要ならご自身でお願いします。

Sub Macro1()
Dim ret
Dim r As Range
Dim adr As String
Dim cnt As Long
Dim psw As Boolean
Dim mySht, adSht, ws As Worksheet
  Set mySht = ActiveSheet
  ret = Application.InputBox("検索文字列を入力してください")
  If TypeName(ret) <> "Boolean" Then
    With mySht.Cells
      Set r = .Find(ret, LookIn:=xlValues, lookat:=xlPart)
      If Not r Is Nothing Then
        adr = r.Address
        cnt = 1
        For Each ws In Worksheets
          If ws.Name = "検索結果" & ret Then
            psw = True
            Exit For
          End If
        Next ws
        If psw Then
          Set adSht = ws
          adSht.Cells.ClearContents
        Else
          Set adSht = Worksheets.Add
          adSht.Name = "検索結果" & ret
        End If
        adSht.Cells(cnt, 1).Value = r.Value
        adSht.Cells(cnt, 2).Value = adr
        Do
          Set r = .FindNext(r)
          If r.Address = adr Then
            Exit Do
          Else
            cnt = cnt + 1
            adSht.Cells(cnt, 1).Value = r.Value
            adSht.Cells(cnt, 2).Value = r.Address
          End If
        Loop
      End If
    End With
  End If
  mySht.Activate
End Sub

丸投げですか(^^;
以下のマクロをALT+F11でVBE画面を開き、左上のVBA Projectでシート名を右クリックし「挿入」→「標準モジュール」で表示される画面に貼り付けて下さい。マクロの実行はワークシート画面に戻ってALT+F8でマクロ一覧を開き、マクロ名を選択して「実行」ボタンです。

勉強になりませんので解説や再修正はしません。もし修正が必要ならご自身でお願いします。

Sub Macro1()
Dim ret
Dim r As Range
Dim adr As String
Dim cnt As Long
Dim psw As Boolean
Dim mySht, adSht, ws As Wo...続きを読む

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エクセルで検索結果を抽出し、別シートにコピーしたい。

いつも楽しく拝見しております。

すいません、ネットで頑張って調べたのですが、どうしても
ウマくいかないので、ご教授下さい。

エクセルにて、シート1にさまざまな情報が記載されています。
A1を検索ボックスとし、ここに入れた言葉を検索し、対象となった行のみをシート2にコピーしたいと考えています。
※書式もそのままコピーしたいです。

これをマクロにて作成し、使用者にはA1に検索内容を入れてもらった後、マクロが仕込んであるボタンをクリックすれば結果が出てくる・・・と言う形を作りたいです。

検索のみ、コピーのみであれば、それぞれ調べると乗っていたりするのですが、両方をしようとした時、どのような式が必要かがわかりません。

ちなみに、検索は以下のような記述を見つけました。

On Error Resume Next
a = InputBox("検索したい文字を入力してください。")
Cells.Find(what:=a, after:=ActiveCell, LookIn:=xlFormulas, lookat:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, MatchByte:=False, SearchFormat:=False).Activate
End Sub

どのような記述を行えば出来るのでしょうか。
また、参考文献が掲載されているURLでも結構です。

どうかご教授下さい。

宜しくお願い致します。

いつも楽しく拝見しております。

すいません、ネットで頑張って調べたのですが、どうしても
ウマくいかないので、ご教授下さい。

エクセルにて、シート1にさまざまな情報が記載されています。
A1を検索ボックスとし、ここに入れた言葉を検索し、対象となった行のみをシート2にコピーしたいと考えています。
※書式もそのままコピーしたいです。

これをマクロにて作成し、使用者にはA1に検索内容を入れてもらった後、マクロが仕込んであるボタンをクリックすれば結果が出てくる・・・と言う形を作りたい...続きを読む

Aベストアンサー

>A1を検索ボックスとし、ここに入れた言葉を検索し、

>a = InputBox("検索したい文字を入力してください。")
がかみ合いませんが。

Findメソッドでのデータ検索 
http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/vba_find.html#find
この事ではないかと。

データの範囲及びシート2の貼付ける位置が不明ですが。
InputBoxで値を入力し、シート1の全セルを検索範囲とし、シート2の1行目に貼付けるとするなら、

Sub try()
Dim str As Variant
Dim r As Range

str = InputBox("検索したい文字を入力してください。")

If str = "" Then Exit Sub

Set r = Worksheets("Sheet1").Cells.Find(What:=str, LookIn:=xlValues, _
LookAt:=xlWhole)

If r Is Nothing Then Exit Sub

r.EntireRow.Copy Worksheets("Sheet2").Rows(1)
Set r = Nothing
End Sub

こんなとか?

>A1を検索ボックスとし、ここに入れた言葉を検索し、

>a = InputBox("検索したい文字を入力してください。")
がかみ合いませんが。

Findメソッドでのデータ検索 
http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/vba_find.html#find
この事ではないかと。

データの範囲及びシート2の貼付ける位置が不明ですが。
InputBoxで値を入力し、シート1の全セルを検索範囲とし、シート2の1行目に貼付けるとするなら、

Sub try()
Dim str As Variant
Dim r As Range

str = InputBox("検索し...続きを読む

QEXCELの検索結果を別シートに貼り付けたい

学校で事務を行っています。

成績の管理をエクセルで行っているのですが、特定の生徒について成績データを
取り出したく、質問をお願いします。m(_ _)m

作成した成績データSheetのうち、番号を指定した生徒について、成績取込Sheetに
教科コードが一致する教科の点数・生徒番号・生徒氏名をVBAを使用して貼り付け
たいのですが、どのようすればよいでしょうか?

よろしくお願いいたします。

Aベストアンサー

こんにちは!
画像がはっきり確認できないのですが、
「成績取込」Sheetにユーザーフォームを配置しているのでしょうか?

今回はユーザーフォームではなく、「成績取込」SheetのA1セルに「生徒番号」を入力してマクロを実行する方法にしてみました。
尚、「成績取込」SheetのA・B列は入力済みだとします。

Alt+F11キー → メニュー → 挿入 → 標準モジュール → VBE画面に
↓のコードをコピー&ペーストしてマクロを実行してみてください。

Sub 抽出()
Dim i As Long, k As Long, endRow As Long, wS1 As Worksheet, wS2 As Worksheet
Set wS1 = Worksheets("成績データ")
Set wS2 = Worksheets("成績取込")
endRow = wS2.Cells(Rows.Count, "A").End(xlUp).Row
Application.ScreenUpdating = False
Range(wS2.Cells(5, "C"), wS2.Cells(endRow, "E")).ClearContents
For k = 5 To wS2.Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To wS1.Cells(Rows.Count, "A").End(xlUp).Row
If wS1.Cells(i, "C") = wS2.Range("A1") And wS1.Cells(i, "A") = wS2.Cells(k, "A") Then
With wS2.Cells(k, "C")
.Value = wS1.Cells(i, "C")
.Offset(, 1) = wS1.Cells(i, "D")
.Offset(, 2) = wS1.Cells(i, "E")
End With
End If
Next i
Next k
Application.ScreenUpdating = True
End Sub

こんな感じではどうでしょうか?m(_ _)m

こんにちは!
画像がはっきり確認できないのですが、
「成績取込」Sheetにユーザーフォームを配置しているのでしょうか?

今回はユーザーフォームではなく、「成績取込」SheetのA1セルに「生徒番号」を入力してマクロを実行する方法にしてみました。
尚、「成績取込」SheetのA・B列は入力済みだとします。

Alt+F11キー → メニュー → 挿入 → 標準モジュール → VBE画面に
↓のコードをコピー&ペーストしてマクロを実行してみてください。

Sub 抽出()
Dim i As Long, k As Long, endRow As Long, wS1...続きを読む

QVBAで検索して、行をコピー&追加したい

Excel2010で以下のことをしたいのですが、VBAがあまりできないのでやれません。
どうか助けてください。

・sheet1のA列に検索用の番号(例として商品番号)が入力されています。
・sheet2はデータベースで、A列に商品番号B列に商品名、C列に国名、D列に価格・・~その後J列まで情報が入っています。(行数は1万行)
・sheet1に入っている商品番号でデータベースから行をピックアップし、該当の行をsheet1のB列以降にコピーしたいのです。
(シート3を新しく作っても構いません。やりやすい方で)
・ただし、同じ商品番号で複数の行がヒットしますので、複数の行がヒットしたら行を追加しながら、行をコピーしたいです。

どのように書いたら良いか参考になるURLだけでもご教授ください。
よろしくお願いします。

Aベストアンサー

もう回答が付いてますね、でもせっかく書いたのだからあげときます(笑)

Sub main()

Dim i1 As Long, i2 As Long, i3 As Long
Dim LastRow1 As Long, LastRow2 As Long

'各シートのデータの最終行を取得
LastRow1 = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
LastRow2 = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
i3 = 1

Worksheets.Add 'ワークシート3を作成
ActiveSheet.Name = "Sheet3"
'シート1の文字列がシート2にあるか探し、あればシート2の該当行をシート3にコピー
For i1 = 1 To LastRow1
For i2 = 1 To LastRow2
If Worksheets("Sheet2").Cells(i2, 1) = Worksheets("Sheet1").Cells(i1, 1) Then
Worksheets("Sheet2").Cells(i2, 1).EntireRow.Copy Destination:=Worksheets("Sheet3").Rows(i3)
i3 = i3 + 1
End If
Next i2
Next i1

End Sub

もう回答が付いてますね、でもせっかく書いたのだからあげときます(笑)

Sub main()

Dim i1 As Long, i2 As Long, i3 As Long
Dim LastRow1 As Long, LastRow2 As Long

'各シートのデータの最終行を取得
LastRow1 = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
LastRow2 = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
i3 = 1

Worksheets.Add 'ワークシート3を作成
ActiveSheet.Name = "Sheet3"
'シート1の文字列がシート2にあ...続きを読む

QVBAで他のシートの特定の列を検索・コピーし、貼り付ける。

お世話になります。
VBA初心者です、よろしくお願いいたします。
掲題にありますとおり、他のシートの特定の列を検索(抽出?)しアクティブになっているシートの特定の列に貼り付ける作業を自動で行わせたいと思っております。複数ある行の中から必要な行だけを抽出して、貼り付けるのでフォーマットを整えると思っていただければ結構です。具体的には、
[Sheet1]のデータ↓( | ←は罫線と思ってください。列の順番は毎回A→Zの順番とは限りませんが、記載内容は同じです。)
A | B | C | D | E … | Z
1 | 2 | 3 | 4 | 5 … |26
a | b | c | d | e … | z
1a| 2b| 3c| 4d| 5e… |26z
これらのデータから、特定の必要な列を選んで[Sheet2]に貼り付けを自動で行わせたいのです↓。
[Sheet2]B,G,A,W,O,Iのデータのみ必要な場合
B | G | A | W | O | I
2 | 7 | 1 | 23| 15| 9
b | g | a | w | o | i
2b| 7g| 1a|23w|15o| 9i

行数は最大で500行を超えます。HLOOKUPを各セルに書き込んで置けばよいのですが、ドッラグでは式が正しく書き込めなくて。。。
"=HLOOKUP(A1,Sheet1!A:Z,2,0)"←"A1"はA2,A3,A4となるのですが"2"がずっと2のままなので。

[Sheet1]の特定の行のコピー&ペーストなのですが、[Sheet2]の貼り付け先が1行目からではないので、何かしらの工夫が必要だと思うのですが。。。
たとえば
Columns("B:B").Select
Selection.Copy
Sheets("Sheet2").Select
Cells(2, 1).Paste
こう言う事って出来ませんよね?

私の意は伝わりましたでしょうか?なにとぞよろしくお願いいたします。

お世話になります。
VBA初心者です、よろしくお願いいたします。
掲題にありますとおり、他のシートの特定の列を検索(抽出?)しアクティブになっているシートの特定の列に貼り付ける作業を自動で行わせたいと思っております。複数ある行の中から必要な行だけを抽出して、貼り付けるのでフォーマットを整えると思っていただければ結構です。具体的には、
[Sheet1]のデータ↓( | ←は罫線と思ってください。列の順番は毎回A→Zの順番とは限りませんが、記載内容は同じです。)
A | B | C | D | E … | Z
1 | 2 | 3 ...続きを読む

Aベストアンサー

こんなのではどうでしょうか?

Sub sample()
'初期設定(コピー元とコピー先のシート、コピーする列を設定)
Dim srcSheet As Worksheet
Dim dstSheet As Worksheet
Dim copyColumns As String
Set srcSheet = Sheets("Sheet1")
Set dstSheet = Sheets("Sheet2")
copyColumns = "B,G,A,W,O,I"
'
Dim srcRowTop As Long
Dim srcRowBottom As Long
Dim dstRowTop As Long
Dim dstColumnLeft As Integer
Dim cols() As String
Dim i As Integer
'コピー元の最初と最後の行を取得(有効なデータ行は、A列には必ずデータがあるとします)
srcRowTop = 1
srcRowBottom = srcSheet.Cells(srcSheet.Rows.Count, 1).End(xlUp).Row 'A列の最後のデータの行
If (srcRowBottom = 1) And (srcSheet.Cells(1, 1) = "") Then '最後の行が1行目で、実は1行目にデータが無い場合
Exit Sub 'コピー元データなし
End If
'コピー先の最初の行を設定
dstRowTop = 10 'C10の10
dstColumnLeft = 3 'C10のC(=3)
'コピーする列名を配列へ取得
cols = Split(copyColumns, ",")
'コピー開始
For i = 0 To UBound(cols)
srcSheet.Range(cols(i) & srcRowTop & ":" & cols(i) & srcRowBottom).Copy Destination:=dstSheet.Cells(dstRowTop, i + dstColumnLeft)
Next
End Sub

ちなみに、コピー先が変わったら
'コピー先の最初の行を設定
dstRowTop = 10 'C10の10
dstColumnLeft = 3 'C10のC(=3)
の部分を変更してください。

こんなのではどうでしょうか?

Sub sample()
'初期設定(コピー元とコピー先のシート、コピーする列を設定)
Dim srcSheet As Worksheet
Dim dstSheet As Worksheet
Dim copyColumns As String
Set srcSheet = Sheets("Sheet1")
Set dstSheet = Sheets("Sheet2")
copyColumns = "B,G,A,W,O,I"
'
Dim srcRowTop As Long
Dim srcRowBottom As Long
Dim dstRowTop As Long
Dim dstColumnLeft As Integer
Dim cols() As String
Dim i As Integer
'コピー元の最初と最後の行を取得(有効なデータ行は...続きを読む

QEXCEL VBA 別シートの文字をシート内で検索

excel2003 VBAで SHEET2に格納されているセルの文字をSHEET1のB列1~9000程度までの文字列の中で一致または部分一致するものがあればそのセル(B列のセル)をSHEET3に順次A列に出力したいのですが、うまくできません。SHEET2に格納されている場所はA列で(SHEET1、SHEET2の文字とも増える可能性あり)

宜しくお願いします。

Aベストアンサー

sub macro1r1()
 dim h as range
 dim c as range
 dim c0 as string

 worksheets("Sheet3").cells.clearcontents
 for each h in worksheets("Sheet2").range("A1:A" & worksheets("Sheet2").range("A65536").end(xlup).row)
  if h <> "" then
   set c = worksheets("Sheet1").range("B:B").find(what:=h.value, lookin:=xlvalues, lookat:=xlpart)
   if not c is nothing then
    c0 = c.address
    do
     worksheets("Sheet3").range("A65536").end(xlup).offset(1).value = c.value
     set c = worksheets("Sheet1").range("B:B").findnext(c)
    loop until c.address = c0
   end if
  end if
 next

 worksheets("Sheet3").select
 range("A1:B1") = array("res", "work")
 range("B2:B" & range("A65536").end(xlup).row).formula = "=MATCH(A2,Sheet1!B:B,0)"
 range("A:B").sort key1:=range("B1"), order1:=xlascending, header:=xlyes
 range("B:B").clearcontents
end sub


sub macro2r1()
 dim Target as range
 dim Crit as range
 dim r as long

 worksheets("Sheet3").cells.clearcontents
 with worksheets("sheet1")
 .range("1:1").insert shift:=xlshiftdown
 .range("B1") = "myList"
 set target = .range(.range("B1"), .range("B65536").end(xlup))
 end with

 with worksheets("sheet2")
 .range("1:1").insert shift:=xlshiftdown
 .range("B:B").insert shift:=xlshifttoright
 .range("A1:B1") = "myList"
 r = .range("A65536").end(xlup).row
 with .range("B2:B" & r)
  .formula = "=""*""&A2&""*"""
  .value = .value
 end with
 set crit = .range("B1:B" & r)
 end with

 target.advancedfilter _
  action:=xlfiltercopy, _
  criteriarange:=crit, _
  copytorange:=worksheets("Sheet3").range("A1"), _
  unique:=false

 worksheets("Sheet2").range("B:B").delete shift:=xlshifttoleft
 worksheets("Sheet2").range("1:1").delete shift:=xlshiftup
 worksheets("Sheet1").range("1:1").delete shift:=xlshiftup
end sub

sub macro1r1()
 dim h as range
 dim c as range
 dim c0 as string

 worksheets("Sheet3").cells.clearcontents
 for each h in worksheets("Sheet2").range("A1:A" & worksheets("Sheet2").range("A65536").end(xlup).row)
  if h <> "" then
   set c = worksheets("Sheet1").range("B:B").find(what:=h.value, lookin:=xlvalues, lookat:=xlpart)
   if not c is nothing then
    c0 = c.address
    do
     worksheets("Sheet3").range("A65536").end(xlup).offset(1).value =...続きを読む

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

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

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

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

Aベストアンサー

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

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

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[初心者です]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ランキング