出産前後の痔にはご注意!

エクセルのマクロで検索・抽出したデータを修正及び更新して元データに反映させたい。

Sheet1に元データが行単位で入力されています。。
  A   B    C    D    E F
1 日付顧客名契約料担当回収日回収金額
2
3
|
50

Sheet2で複数条件でフィルタオプションをマクロで実行し結果を表示ています。
  A    B    C   D    E
1 日付~ 日付マデ 顧客名 担当者
2 1/1   2/28     高橋      --------->検索条件
3
4 日付顧客名担当回収日回収金額
5 -------------------------------------->抽出結果
6 -------------------------------------->抽出結果
7 -------------------------------------->抽出結果

マクロは下記の通りです。

Public Sub 検索()
Dim myRow1 As Long, myRow2 As Long
'----Sheet1とSheet2のA列で最終行を捜します。
myRow1 = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
myRow2 = Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row
'----Sheet2のA5以下が入力されていたらクリアします。
If myRow2 >= 5 Then
Sheets("Sheet2").Range("A5:P" & myRow2).ClearContents
End If
'----フィルタオプションの設定で抽出します。
'----元データはSheet1、抽出条件はSheet2のA1:D2、抽出先はSheet2のA4:E4です。
Sheets("Sheet1").Range("A1:F" & myRow1).AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Sheet2").Range("A1:D2"), _
CopyToRange:=Sheets("Sheet2").Range("A4:E4"), _
Unique:=False

End Sub

抽出結果の各セルデータを必要に応じて変更・修正(選出結果を直に)をしそれを元データ
に反映(上書き?)させるようなマクロを作成したいです。

どなたかご指導よろしくお願いいたします。

うまく説明できないので画像を添付します。

「エクセルのマクロで検索・抽出したデータを」の質問画像

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

A 回答 (2件)

質問者のレベルではChangeイベントはちょと難しいかも。

。(^^;;;

で、Sheet2に抽出後、修正データを入れ、
それが正しいかどうか確認した後に、Sheet1へ転記する方がいいかも。

'------------------------------------------------ 
Sub 更新()
 Dim R1 As Long
 Dim R2 As Long

For R2 = 5 To Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row
 For R1 = 2 To Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row

 If Sheets("Sheet1").Cells(R1, "A") = Sheets("Sheet2").Cells(R2, "A") And _
   Sheets("Sheet1").Cells(R1, "B") = Sheets("Sheet2").Cells(R2, "B") And _
   Sheets("Sheet1").Cells(R1, "D") = Sheets("Sheet2").Cells(R2, "C") Then

   Sheets("Sheet1").Cells(R1, "E") = Sheets("Sheet2").Cells(R2, "D")
   Sheets("Sheet1").Cells(R1, "F") = Sheets("Sheet2").Cells(R2, "E")
   Exit For
 End If

 Next R1
Next R2
End Sub
'-------------------------------------------

一行のコードが長くなるのでRangeのValueプロパティは省いてあります。


それから処理の流れには関係ないことですが、
シートを扱うために変数を使うとコードが短くすっきりなります。
  Dim WS1 As Worksheets
  Set WS1 = Worksheets("Sheet1")
最初でこのようしておくと、
以後、Worksheets("Sheet1")の代わりにWS1を使えるということです。

以上です。
 
    • good
    • 0
この回答へのお礼

お礼が遅くなり申し訳ございません。
大変参考になりました。

ありがとうございます。

お礼日時:2010/10/21 17:00

シート2の検索結果を表示させる際に元の表の何行目かを同時に表示させるようにします。


シート2で変更した場合にはPrivate Sub Worksheet_Change(ByVal Target As Range) で変更されたデータのある行での元の表の行を求めて元の表のデータを変更するようにすればよいでしょう。

この回答への補足

ご回答ありがとうございます。
なにぶん初心者なので・・・

具体的に検索表示と更新するためのマクロを教えていただけないでしょうか?

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

補足日時:2010/10/15 14:21
    • good
    • 1
この回答へのお礼

ありがとうございます。

お礼日時:2010/10/15 14:21

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

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

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

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

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

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ユーザフォームを使ってのデータの書き換え(エクセル)

sheet1に下記のように商品のデータ一覧が入っており、
価格の改定があった時に[単価]に新しい価格をいれ、
当初[単価]に入っていた価格を[旧単価]に入れるようを作っています。

コード 商品名  単価  旧単価  改定日
1111  商品A  1000
1112  商品B  1500
1113  商品C  1200



コード 商品名  単価  旧単価  改定日
1111  商品A  1100  1000   2008/5/2
1112  商品B  1500
1113  商品C  1200

<UserForm>
コード [コードのTextBox]
商品名[商品名のLabel]
単価  [単価ののLabel]
新単価[新単価のTextBox]
改定日[改定日のTextBox]


ユーザーフォムでテキストボックスにコードを入れたら、
コードを商品のデータ一覧から検索して商品名と単価を
ユーザーフォムのLabel Captionに自動で表示されるようにしたいのです。

1.コードの入力
2.商品名、単価が表示される
3.新単価、改定日の入力
4.元のデータ(Sheet1)の書き換え

上記のような順序で考えていたのですが、
どうしてもコード入力からの検索表示が上手くいかないのです。
どうすれば良いのでしょうか?

※ユーザーフォームで[商品名][単価]をLabelにしてるのは、
数値・文字列として書き換えの必要がないので動かせないほうがいいのでは
とういう個人的な思い込みからですので、特にこだわりはございません。

相当な初心者のため、少しばかり注釈をつけてくださる大変ありがたいです。
上記のよう順番でなくても、よい方法があれば教えて下さい。
よろしくお願い致します。

sheet1に下記のように商品のデータ一覧が入っており、
価格の改定があった時に[単価]に新しい価格をいれ、
当初[単価]に入っていた価格を[旧単価]に入れるようを作っています。

コード 商品名  単価  旧単価  改定日
1111  商品A  1000
1112  商品B  1500
1113  商品C  1200



コード 商品名  単価  旧単価  改定日
1111  商品A  1100  1000   2008/5/2
1112  商品B  1500
1113  商品C  1200

<UserForm>
コード [コードのTextBox]
商品名[商品名...続きを読む

Aベストアンサー

コードのテキストボックスのChangeイベントで検索すればいいのでは

たとえば
コードテキストボックス : CodeText
新単価テキストボックス : NewPriceText
改定日テキストボックス : UpdateDateText
商品名ラベル      : NameLabel
単価ラベル       : PriceLabel
データの記述してあるシート: 商品マスター
といった名前だとします

Sub CodeText_Change()
  ' 検索二一致したセルを記憶する変数
  dim r as Range
  Set r = Worksheets("商品マスター").Range("A:A"). _
    Find( CodeText.Text, MatchCase = False )
  if r is nothing then
    ' 検索したが コードが見つからなかった場合
    Name.Label.Caption = "---"
    PriceLabel.Caption = "---"
    NewPriceText.Text = ""
    UpdateText.Text = ""
  else
    ' 該当コードがある場合
    ' 見つかったセルの隣のセルの内容をコントロール設定
    ' この場合に Rangeオブジェクトの Offsetメソッドで指示
    Name.Label.Caption = r.Offset(0,1).Value
    PriceLabel.Caption = r.Offset(0,2).Value
    NewPriceText.Text = r.Offset(0,2).Value
    UpdateText.Text = r.Offset(0,4).Value
  end if
End Sub

といった具合で検索出来るともいます

改訂 などのボタンを準備しておいて
Sub Kaitei_Click()
dim r as Range
  Set r = Worksheets("商品マスター").Range("A:A"). _
    Find( CodeText.Text, MatchCase = False )
  if r is Nothing then
    MsgBox "コードが見つかりません"
    Exit Sub
  end if
  ' 単価を更新
  r.Offset(0,2).value = NewPriceText.Text
  ' 旧単価列を更新
  r.Offset(0,3).Value = PriceLabel.Caption
  ' 改訂日を更新
  r.Offset(0,4).Value = DateValue( UpdateText.Text )
End Sub

# エラー処理を何もしていないので 適宜書き加えてください
# 日付がありえない日付であるとか、単価が金額として意味を成さない文字列であるとか
# 必要な箇所のデータが入力されていないなど

コードのテキストボックスのChangeイベントで検索すればいいのでは

たとえば
コードテキストボックス : CodeText
新単価テキストボックス : NewPriceText
改定日テキストボックス : UpdateDateText
商品名ラベル      : NameLabel
単価ラベル       : PriceLabel
データの記述してあるシート: 商品マスター
といった名前だとします

Sub CodeText_Change()
  ' 検索二一致したセルを記憶する変数
  dim r as Range
  Set r = Worksheets("商品マスター").Range("A:A"). _
   ...続きを読む

QVBAで検索後、行番号取得し上書き保存

 Excel2002です。入力シートと一覧シートを作成し、入力シートの入力フォームに入力すると一覧シートの表の最終行に新規で転記されるようにしました。
 また、入力シートでカタカナ検索すると、入力フォームに表示され、そのデータがある行番号をA1セルに取得するまではできました。検索表示したデータを修正し、取得した行番号に上書きしたいのですが、どうしても2行下に上書きされてしまいます。
 取得行番号 980  → 上書きされる行番号 982
そのまま980行にデータを上書きしたい場合、どうしたらいいのでしょうか?
 困っています。よろしくお願い致します。
--------------------------------------------------------------
Sub 新規レコード転記2()
Dim motoSht As Worksheet, sakiSht As Worksheet, sakiTbl As Range, sakiRng As Range, i As Long
Dim lastRec As Range, newRec As Range
Dim motoHani()

Application.ScreenUpdating = False '画面の更新をストップ


Set sakiSht = Sheets("一覧")

motoHani = Array("D4", "C6", "I6", "C7", "J7", "C8", "C9", "C10", "H10", "C11", "I11", "C12", "E12", "H12", "J12", "C14", "C13", "E13", "H13", "J13", "C15", "C16")

Set sakiRng = sakiSht.Range("B" & Rows.Count).End(xlUp).Offset(1)

For i = 0 To UBound(motoHani)
sakiRng.Offset(0, i).Value = motoSht.Range(motoHani(i)).Value
motoSht.Range(motoHani(i)).MergeArea.ClearContents
Next


MsgBox "入力を完了しました。"
End Sub

Sub 情報検索()
Dim tmpInt As String, motoHani(), myRng As Range, i As Integer
'変数の宣言
tmpInt = Sheets("入力").Range("D4").Value
'検索する文字列を取得
motoHani = Array("C6", "I6", "C7", "J7", "C8", "C9", "C10", "H10", "C11", "I11", "C12", "E12", "H12", "J12", "C14", "C13", "E13", "H13", "J13", "C15", "C16")
'転記する位置を設定

Set myRng = Range("顧客情報").Columns(1).Find(tmpInt, LookAt:=xlWhole)
'顧客情報の1フィールド目を対象に検索

If myRng Is Nothing Then
MsgBox "該当するレコードはありませんでした"
Exit Sub
End If
'検索値が無かった場合は処理を抜ける
For i = 0 To UBound(motoHani)
Range(motoHani(i)).Value = myRng.Offset(0, i + 1)
Next
'検索値が見つかったセルを元にレコードの情報を転記

'検索した行番号をA1セルに保存
Range("A1") = myRng.Row



End Sub

Sub 修正して上書き()
Dim no As Long, motoHani(), i As Integer

no = Range("A1")
motoHani = Array("D4", "C6", "I6", "C7", "J7", "C8", "C9", "C10", "H10", "C11", "I11", "C12", "E12", "H12", "J12", "C14", "C13", "E13", "H13", "J13", "C15", "C16")
For i = 0 To UBound(motoHani)
Range("顧客情報").Cells(no, i + 1) = Range(motoHani(i)).Value

Next

MsgBox "修正しました。"


End Sub
---------------------------------------------------------------

 Excel2002です。入力シートと一覧シートを作成し、入力シートの入力フォームに入力すると一覧シートの表の最終行に新規で転記されるようにしました。
 また、入力シートでカタカナ検索すると、入力フォームに表示され、そのデータがある行番号をA1セルに取得するまではできました。検索表示したデータを修正し、取得した行番号に上書きしたいのですが、どうしても2行下に上書きされてしまいます。
 取得行番号 980  → 上書きされる行番号 982
そのまま980行にデータを上書きしたい場合、どうしたらい...続きを読む

Aベストアンサー

遅くなったので、もう解決済みかな?

Sub 修正して上書き()
Dim no As Long, motoHani(), i As Integer
no = Range("A1")-2  'ここで-2とするか
  ・
  ・
For i = 0 To UBound(motoHani)
'↓ここで-2にするか .Cells(no-2, i + 1)
Range("顧客情報").Cells(no, i + 1) = Range(motoHani(i)).Value
Next
MsgBox "修正しました。"
End Sub

ではダメですか

Q検索して修正したデータの上書転記

Sub 検索()
Dim tmpInt As Integer, motoHani(), myRng As Range, i As Integer
tmpInt = Sheets("入力フォーム").Range("C4").Value
motoHani = Array("C10", "C12", "C13")
Set myRng = Range("テーブル").Columns(1).Find(tmpInt, LookAt:=xlWhole)
If myRng Is Nothing Then
MsgBox "該当するレコードはありませんでした"
Exit Sub
End If
For i = 0 To UBound(motoHani)
Range(motoHani(i)).Value = myRng.Offset(0, i + 1)
Next
End Sub

入力シートと一覧表シートを作成し入力シートの入力フォームにデータを入れてマクロを実行すると一覧表シートにレコード転記されるようにしました。

一覧表シートに転記したデータを,検索し入力フォーム上に表示させることはできたのですが、データを修正して一覧表シートに更新(上書転記)させる方法がわかりません。どうかご存知の方、教えてください。

Sub 検索()
Dim tmpInt As Integer, motoHani(), myRng As Range, i As Integer
tmpInt = Sheets("入力フォーム").Range("C4").Value
motoHani = Array("C10", "C12", "C13")
Set myRng = Range("テーブル").Columns(1).Find(tmpInt, LookAt:=xlWhole)
If myRng Is Nothing Then
MsgBox "該当するレコードはありませんでした"
Exit Sub
End If
For i = 0 To UBound(motoHani)
Range(motoHani(i)).Value = myRng.Offset(0, i + 1)
N...続きを読む

Aベストアンサー

3度書き、大変申し訳ありません。(前の回答消して欲しいっす)

Sub 検索()
   ・・・ 略 ・・・
  Range("A1") = myRng.Row
End Sub

Sub 登録()
  no = Range("A1")
  motoHani = Array("C4", "C10", "C12", "C13")
  For i = 0 To UBound(motoHani)
    Range("テーブル").Cells(no, i + 1) = Range(motoHani(i)).Value
  Next
End Sub

で、どうですか?
・一応検索した行数をA1セルに保存しています。
・登録後、セルをクリアするなどはアレンジしてください
・型宣言何もしてません。

文章での説明は大変苦手です。失礼しました。

QExcel VBA 検索した値を入力フォームに表示

VBA初心者ながら、顧客管理用に入力フォームなどを作っています。

検索フォームを作成し、名前や住所などをキーワードに実行ボタンを押して検索すると、顧客シートからデータを引っ張ってきて、検索フォームの下に対象リストが表示されます。(今回の場合は顧客シートのNo1、12、17のデータを引っ張ってきています。)

そこから、イメージとしては、画像のように3件結果が出力された内、一番上の検索結果をクリックすると、入力フォームに選択した対象者の情報が表示されるようなことをしたいのですが、何から手をつけたらよいかがわかりません・・・。

ちなみに、検索フォームに表示される値は、実際の入力フォームに入力する項目より少ない(例えば、入力フォームでは「ふりがな」がありますが、検索フォームに検索結果としては「ふりがな」は表示されていません。)

かなり大雑把な質問ですが、アドバイスなど頂けると幸いです。

Aベストアンサー

リストで選択したデータが存在する行番号が rowNumber に正しく取得できていますか?
私のサンプルで想定している環境は以下のように想定しています。

・ データ群が書き込まれているシートの 1行目が項目名になっていて、2行目からデータが入力されている。
・ 1つのデータは 1行で完結する。
・ 1列目(A列)には抜けもれなく通し番号が振ってある。(1件目の A2 が 1 で、 2件目の A2 が2、以下 1ずつ増えていっている)
・ 検索フォームのリストボックスの 1列目は、データ群のシートの A列の値(通し番号)が表示されている。

という状況なので、
1. 検索結果のリストから 1つのクリックする。
2. クリックされたリスト項目の 1列目の値をもとに、元の場所の行番号を割り出す。(元のデータのシートは 2行目からデータが始まっているのでリスト項目 1列目の値に 1 を加算すれば元の行番号になる)


もし以下のような環境だと、選択したリスト項目の内容から元のデータの行番号を推察することができません。
・ データ群のシートの 1列目は ID となっていて、改廃されていくと番号が飛ぶこともある。
・ 検索フォームのリストの 1列目は ID の値である。

この場合はリストボックスの 1列目に隠し列を作って起き、元の行番号を表示させておくのはどうでしょうか。
1列目の列幅を 0 pt にすれば見えません。(ColumnWidth プロパティ)

リストで選択したデータが存在する行番号が rowNumber に正しく取得できていますか?
私のサンプルで想定している環境は以下のように想定しています。

・ データ群が書き込まれているシートの 1行目が項目名になっていて、2行目からデータが入力されている。
・ 1つのデータは 1行で完結する。
・ 1列目(A列)には抜けもれなく通し番号が振ってある。(1件目の A2 が 1 で、 2件目の A2 が2、以下 1ずつ増えていっている)
・ 検索フォームのリストボックスの 1列目は、データ群のシートの A列の値(通し番号)...続きを読む

Qエクセルで複数の条件を抽出し自動的に別シートに反映する方法を教えてください。

こんばんは。教えてください。

元データ(sheet1)を更新するたび
2つの条件にあったデータを
別シートに自動的に抽出したいので
適した関数がありましたら教えてください。



◇シート1◇ ※元データ
 A      B     C     D     F
1 氏名 役職 部署 年齢 移動時期     
2 山田 社員 開発 45  未調整
3 田中 社員 人事 42  4/1~
4 鈴木 派遣 企画 30  
5 高橋 役員 人事 50  未調整
6 坂野 社員 企画 33  未調整  
7 井上 派遣 企画 29  未調整

◇シート2◇ ※部署が人事で移動時期が未調整の人のみ抽出
 A      B     C     D    F
1 氏名 役職 部署 年齢 移動時期 
2 高橋 役員 人事 50  未調整


補足
・元データ(シート1)はこれからもデータを追加するので
 その度、シート2、シート3もそれぞれ自動で反映されるようにした いです。

・マクロ、VBAは知識がないので
 関数で作成したいです。

・できるだけエラー(#N/Aなど)表示されないようにしたいです。

説明が不十分で伝わりにくいかと思いますが
よろしくお願いします。

こんばんは。教えてください。

元データ(sheet1)を更新するたび
2つの条件にあったデータを
別シートに自動的に抽出したいので
適した関数がありましたら教えてください。



◇シート1◇ ※元データ
 A      B     C     D     F
1 氏名 役職 部署 年齢 移動時期     
2 山田 社員 開発 45  未調整
3 田中 社員 人事 42  4/1~
4 鈴木 派遣 企画 30  
5 高橋 役員 人事 50  未調整
6 坂野 社員 企画 33  未調整  
7 ...続きを読む

Aベストアンサー

> 部署を"人事"と"企画"の両方で抽出する条件を追加する

おはようございます、merlionXXです。
Operator:=xlOr, Criteria2:="=企画" と、OR条件で"企画"を加えれば可能です。
一応、各コードの動きに解説もつけておきました。(解説は’でコメントアウトしてますのでこのまま貼り付けてもOKです。)

Private Sub Worksheet_Activate() 'このシートがアクティブになったら自動実行
With Sheets("Sheet1") 'Sheet1対して
.AutoFilterMode = False 'オートフィルタ終了(あればエラーになるため)
.Range("A1:E1").AutoFilter 'A1:E1にオートフィルタ設定
.Range("A1:E1").AutoFilter Field:=3, Criteria1:="=人事", Operator:=xlOr, Criteria2:="=企画" '左から3つ目のフィルタを"人事"と"企画"のOR条件で抽出
.Range("A1:E1").AutoFilter Field:=5, Criteria1:="未調整" '左から5つ目のフィルタを"未調整"で抽出
.Range(.Range("A1"), .Range("A1").SpecialCells(xlLastCell)).SpecialCells(xlCellTypeVisible).Copy Range("A1") 'A1から最終セル範囲の可視セルをこのシートのA1以降に貼り付け
.AutoFilterMode = False 'オートフィルタ終了
End With 'Sheet1に対する記述おわり
End Sub

> 部署を"人事"と"企画"の両方で抽出する条件を追加する

おはようございます、merlionXXです。
Operator:=xlOr, Criteria2:="=企画" と、OR条件で"企画"を加えれば可能です。
一応、各コードの動きに解説もつけておきました。(解説は’でコメントアウトしてますのでこのまま貼り付けてもOKです。)

Private Sub Worksheet_Activate() 'このシートがアクティブになったら自動実行
With Sheets("Sheet1") 'Sheet1対して
.AutoFilterMode = False 'オートフィルタ終了(あればエラーになるた...続きを読む

QExcel VBA 検索して該当行を抽出

はじめまして、下記のように、Excelでマクロを組みたいのですが
組み方がわかりません。
ご教授願えませんでしょうか。

MS Ofiice2010 生徒数500名ほど
シート1には生徒の生徒番号、氏名などがあります。
     A     B     C     D
1 生徒番号   氏名   備考
2 120001     田中
3 120002     山田  試験時休み
4 T120009    相田   転入

シート2には生徒の成績表:生徒番号、氏名、国語、算数、理科、社会
生徒番号でソートされていません。
     A     B     C     D     E     F   
1 生徒番号   氏名   国語   算数   理科   社会  
2 120001     田中   80    65     65     75
3 T120009    相田   90    85     80     80

シート1の生徒番号でシート2生徒番号を検索して、該当したら成績を
シート1の検索した生徒番号のD列以降にコピーしたいのですが
     A     B     C     D     E     F     G
1 生徒番号   氏名   備考   国語   算数   理科   社会
2 120001     田中         80    65     65     75
3 120002     山田  試験時休み


10 T120009    相田   転入    90    85     80     80

お手数ですが、ご教授願えますでしょうか。
よろしくお願いいたします。

はじめまして、下記のように、Excelでマクロを組みたいのですが
組み方がわかりません。
ご教授願えませんでしょうか。

MS Ofiice2010 生徒数500名ほど
シート1には生徒の生徒番号、氏名などがあります。
     A     B     C     D
1 生徒番号   氏名   備考
2 120001     田中
3 120002     山田  試験時休み
4 T120009    相田   転入

シート2には生徒の成績表:生徒番号、氏名、国語、算数、理科、社会
生徒番号でソートされていません。
   ...続きを読む

Aベストアンサー

こんばんは!
関数ではダメですか?

Sheet1のD2セルに
=IF(COUNTIF(Sheet2!$A:$A,$A2),VLOOKUP($A2,Sheet2!$A:$F,COLUMN(C1),0),"")
という数式を入れオートフィルで列方向・行方向にコピー!

これで大丈夫だと思いますが・・・

※ どうしてもVBAでやりたい場合は、一例です。

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

Sub Sample1() 'この行から
Dim i As Long, n As Long, c As Range, wS1 As Worksheet, wS2 As Worksheet
Set wS1 = Worksheets("Sheet1")
Set wS2 = Worksheets("Sheet2")

For i = 2 To wS1.Cells(Rows.Count, 1).End(xlUp).Row
Set c = wS2.Columns(1).Find(what:=wS1.Cells(i, 1), LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
n = c.Row
wS2.Cells(n, 3).Resize(1, 4).Copy wS1.Cells(i, 4)
End If
Next i
End Sub 'この行まで

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

こんばんは!
関数ではダメですか?

Sheet1のD2セルに
=IF(COUNTIF(Sheet2!$A:$A,$A2),VLOOKUP($A2,Sheet2!$A:$F,COLUMN(C1),0),"")
という数式を入れオートフィルで列方向・行方向にコピー!

これで大丈夫だと思いますが・・・

※ どうしてもVBAでやりたい場合は、一例です。

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

Sub Sample1() 'この行から
...続きを読む

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 複数の条件を含む対象を抜き出す。

エクセルVBAについて質問です。
エクセルのバージョンは2003と2007を主に使用しています。

下記の様なデータがあるときに、部活が「野球」でかつクラブは「囲碁」に入っている生徒の学籍番号を別のシート(Sheet2)のB3から下に順にリスト化するマクロがどうしても出来なくて困っています。
find next等を使うのでは無いかと色々してみましたが上手く出来ない現状です。

<sheet1>
   A      B      C       D    E

1 学籍番号 学年    名前     部活   クラブ
2 2222222   1   山田 太郎  野球   囲碁
3 9854923   2   吉田 次郎   剣道   絵画  
4 1111111   3   佐藤 三郎  野球   囲碁
5 8888883   1   米山 権蔵  卓球   囲碁

Aベストアンサー

こんばんは!
Sheet1のA列(学籍番号)のみをSheet2のB3セル以降に表示すれば良いわけですね?
一例です。

画面左下のSheet1のSheet見出し上で右クリック → コードの表示 → VBE画面に
↓のコードをコピー&ペーストしてマクロを実行してみてください。

Sub test()
Dim i, k As Long
Dim ws As Worksheet
Set ws = Worksheets(2)
k = 2
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
If Cells(i, 4) = "野球" And Cells(i, 5) = "囲碁" Then
k = k + 1
ws.Cells(k, 2) = Cells(i, 1)
End If
Next i
End Sub

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

Q検索結果の指定列をリストボックスに反映したい

ユーザーフォームにTextbox、検索ボタン、Listboxを配置しました。
Textboxに「E列」の大分類(例:「35」)を入力して、検索ボタンを押すと、「35」のレコードのA列とB列だけListboxに反映させるようにしたいです。
皆さん、教えて下さい!宜しくお願いします。

 A列     B列    C列      D列    E列
商品コード/商品名/仕入先コード/仕入先名/大分類
123456 りんご 011 AAA 35
456789 ばなな 012 BBB 35
234567    テーブル  013 CCC 23

Aベストアンサー

元データはSheet1にあるとして

private sub CommandButton1_Click()
 dim r as long
 if me.textbox1 = "" then exit sub
 me.listbox1.clear
 me.listbox1.columncount = 2

 with worksheets("Sheet1")
 for r = 2 To .range("E65536").end(xlUp).row
  if cstr(.cells(r, "E").value) = me.textbox1.value then
   me.listbox1.additem .cells(r, "A").value
   me.listbox1.list(me.listbox1.listcount - 1, 1) = .cells(r, "B").value
  end if
 next r
 end with
end sub

ぐらいで,逐一追加していくのが一番簡単かと思います。


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

人気Q&Aランキング