ママのスキンケアのお悩みにおすすめアイテム

"Sheet1"のA列に区分(文字列)、B列~D列に分析数値があり
A列の文字が条件に一致した行のデータを"Sheet2"にコピー、
元の"Sheet1"のデータは行ごと削除といった形で考えているのですが、どうも上手くいきません。

Dim Keywrd As String
???
With Worksheets("Sheet1").Columns("A:A")
Set Keywrd = .Find("キーワード", LookIn:=xlValues)
???
End With
Set Keywrd = Nothing
TargetCell.EntireRow.Select
Selection.Delete Shift:=xlUp
End Sub


???部分の変数宣言と処理内容をどうすれば良いか、ご教授願えますでしょうか。

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

A 回答 (3件)

こんばんは。



#1の回答者です。一度きりなら、こんな風に直してみたらよいと思います。質問のコードは、変数の流れがおかしくなっているようです。

Sub Macro1()
  Dim Keywrd As String
  Dim TargetCell As Range
  Keywrd = InputBox("キーワードを入れてください", "キーワード入力")
  If Keywrd = "" Then Exit Sub
  With Worksheets("Sheet1").Columns("A:A")
    Set TargetCell = .Find(Keywrd, LookAt:=xlWhole, LookIn:=xlValues)
    If TargetCell Is Nothing Then
      MsgBox Keywrd & " は見つかりません。"
      Exit Sub
    End If
  End With
  'Keywrd = "" ''不要
  TargetCell.EntireRow.Copy Worksheets("Sheet2").Range("A1")
  TargetCell.Delete Shift:=xlUp

End Sub

--------------------------------------
#1 のコードを考え直し修正しました。
私のコードは、必ず、検索値に対して複数、該当するものがあるという条件になっています。

---------------------------------------------
Sub TestFind2()
 Dim myKeyWord As String
 Dim FirstAdd As String
 Dim c As Range
 Dim ur As Range
 myKeyWord = Application.InputBox("検索文字を入れてください", "検索+移動", Type:=2)
 If myKeyWord = "" Or myKeyWord = "False" Then Exit Sub

 With Worksheets("Sheet1").Columns(1)
 .Cells(1).Select
 Set c = .Find( _
      What:=myKeyWord, _
      LookIn:=xlValues, _
      LookAt:=xlWhole, _
      MatchCase:=False, _
      MatchByte:=True)

  If Not c Is Nothing Then
     Set ur = c.EntireRow
     FirstAdd = c.Address
    Do
      Set ur = Union(c.EntireRow, ur)
      Set c = .FindNext(c)
    Loop Until (c Is Nothing) Or (FirstAdd = c.Address)
   End If
   ur.Copy Worksheets("Sheet2").Range("A1")
   ur.Delete Shift:=xlShiftUp
End With
   Set ur = Nothing
End Sub


 
    • good
    • 5
この回答へのお礼

思い通りに動作しましたっ!すごいです。。。
この動作は一度だけになりますので、上の記述を参考にさせて頂きました。

Wendy02さんには前回にも回答頂き、ありがとうございます。
このところ作業を中断しておりましたが、前回の続きです。

全体イメージは見えてきましたので、あとは詳細の詰めとなっております。

お礼日時:2008/05/20 17:17

むつかしい記述になり過ぎていると思う。


FindメソッドはFindNextメソッドなどアリ、初心者にはむつかしい。
別途単純な方法(総当り法)でやってみる。
小生にとって馬鹿の1つ覚えのような方法だが
Sheet1のA列のaの行をSheet2へ抜き出すには
(下記では i は処理対象行ポインタ、K は書き出し行ポインタ)
Sub test01()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
k = 2
i = 2
Do While Cells(i, "A") <> ""
If sh1.Cells(i, "A") = "a" Then
sh2.Cells(k, "A") = sh1.Cells(i, "A")
sh2.Cells(k, "B") = sh1.Cells(i, "B")
sh1.Rows(i).Delete
k = k + 1
Else
i = i + 1
End If
Loop
End Sub
例データ
Sheet1 スタート状態
 A1:B9
区分計数
a3
b5
a2
b3
c1
c2
a6
a7
Sheet2 A2:B5
a3
a2
a6
a7
Sheet1 結果
区分計数
b5
b3
c1
c2
    • good
    • 0
この回答へのお礼

ご教授ありがとうございます。
こんな方法もあったんですね。
VBAを記述する上で、自ら難しくしてしまっている感じです。

ゴール地点は同なのに到達する道筋が色々あって…奥深いですね。
参考に致します。

お礼日時:2008/05/20 16:57

こんばんは。



今回の内容の Find メソッドからでは、かなりむつかしいです。それと、Find メソッドの引数を省略するのが良く分からないです。確か、ワークシート側の検索置換にひきずられてしまったような気がします。

------------------------------------------

Sub TestFind()
 Dim myKeyWord As String
 Dim c As Range
 Dim r As Range
 Dim i As Long
 myKeyWord = Application.InputBox("検索文字を入れてください", "検索+移動", Type:=2)
 If myKeyWord = "" Or myKeyWord = "False" Then Exit Sub

 With Worksheets("Sheet1").Columns(1)
 .Cells(1).Select
 Set c = .Find( _
      What:=myKeyWord, _
      LookIn:=xlValues, _
      LookAt:=xlWhole, _
      MatchCase:=False, _
      MatchByte:=True)

  If Not c Is Nothing Then
    Do
      If Not r Is Nothing Then
       r.Delete
      Set r = Nothing
      End If
      On Error Resume Next
      '削除すると、オブジェクトを失い、エラーが発生する
      c.EntireRow.Copy Worksheets("Sheet2").Range("A1").Offset(i)
      If Err.Number > 0 Then Exit Do
      On Error GoTo 0
      Set r = c.EntireRow
      Set c = .FindNext(c)
      i = i + 1
    Loop
   End If
End With
End Sub
    • good
    • 1

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

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

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

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

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

Q複数条件が一致で別シートに転記【エクセルVBA】

エクセルでセルの条件が複数一致したら別シートに転記される方法をお教えください。
シートを2枚用意して、配達日ごとに一覧化したいのです。
事前に用意したシート(配達表)の“配達”と“配達時間”が一致したら
その方の名前と注文個数を右側に反映したいのですが・・・

注文データが多すぎて困っています。
宜しくお願いします。

■シート名:注文データ
   A    B    C    D    E
------------------------------------------------
1 しめい  対応   配達日   時間   個数
------------------------------------------------
2 たけだ  配達  6/20(月) 13:00  2個
3 みうら  配達  6/18(土) 14:00  4個
4 らもす  郵送  6/20(月)  ―   5個
5 いはら  配達  6/20(月) 14:30  8個
6 かつや  配達  6/20(月) 15:00  6個
7 みうら  郵送  6/20(月)  ―   4個

■シート名:配達表
    A     B    C
------------------------------------
1  配達   6/20(月)
------------------------------------
2  12:00
3  12:30
4  13:00
5  13:30
6  14:30
7  15:00
8  15:30
9  16:00

マクロを実行すると・・・
↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓

■シート名:配達表
    A     B    C
------------------------------------
1  配達   6/20(月)
------------------------------------
2  12:00 
3  12:30
4  13:00    たけだ   2個
5  13:30
6  14:00    みうら   4個
6  14:30   いはら   8個
7  15:00   かつや   6個
8  15:30
9  16:00

エクセルでセルの条件が複数一致したら別シートに転記される方法をお教えください。
シートを2枚用意して、配達日ごとに一覧化したいのです。
事前に用意したシート(配達表)の“配達”と“配達時間”が一致したら
その方の名前と注文個数を右側に反映したいのですが・・・

注文データが多すぎて困っています。
宜しくお願いします。

■シート名:注文データ
   A    B    C    D    E
------------------------------------------------
1 しめい  対応   配達日   時間   個数
-...続きを読む

Aベストアンサー

こういうのは「複数条件による抜き出し問題」だ。
関数で出来ればおなじみのやり方で良いのだが、既に出ているように式が長く複雑で、初心者には何をやって居るかわからない式になる。毎度週に数回このタイプの質問が出て、同じようなタイプの答えになる。Googleででも「imogasi方式」で照会すれば、過去の沢山の例と回答(そのタイプも)が出てくる。
ーー
まず初心者や急ぐ場合はデーターフィルターフィルタオプションの設定で済ませられないか勉強すべきだ。
ーー
本来、こういう仕事の関連のエクセル表は、VBAを勉強してそれを使うべきと思う(既に回答も出ているようだ)
関数で抜き出し問題や表の組み換えは、VBAで無いと、天下りの長い式をコピペで使うだけになる。
ーー
私が紹介している「imogasi方式」では、Sheet2に時刻の所定の行に出す問題なので複雑になりすぎる。
ーー
VBAでやってみる。
例データ
しめい対応配達日時間個数
たけだ配達6月20日13:002個
みうら配達6月18日14:004個
らもす郵送6月20日ーー5個
いはら配達6月20日14:308個
かつや配達6月20日15:006個
みうら郵送6月20日ーー4個
(注意)
「ーー」セルは空白とする
「月日」列は、エクセルの年月日を入れておくこと(日付シリアル値(わかりますか)) 文字列では不可
6/20(月) の様な表示は、表示形式の設定でやること(エクセルの常識)  m/d(aaa)
時間の列も時刻シリアル値で入れてあるとする。文字列では不可
ーー
コード
標準モジュールに
Sub test01()
Dim sh1, sh2
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
d = sh1.Range("A65536").End(xlUp).Row
On Error Resume Next
For i = 2 To d
'--条件をかけて選別
If sh1.Cells(i, "B") = "配達" And sh1.Cells(i, "C") = sh2.Range("B1") And _
sh1.Cells(i, "D") <> "" Then
t = sh1.Cells(i, "D")
'---Sheet2で時刻行を探す
For r = 2 To 30
If sh1.Cells(i, "D") = sh2.Cells(r, "A") Then Exit For
Next r
'--該当行の値をSheet2の時刻該当行セット
Sheet2.Cells(r, "B") = sh1.Cells(i, "A")
Sheet2.Cells(r, "C") = sh1.Cells(i, "E")
End If
Next i
End Sub
ーー
実行結果
Sheet2
配達6月20日
12:00
12:30
13:00たけだ2個
13:30
14:00
14:30いはら8個
15:00かつや6個
15:30
16:00
・・・・・・

こういうのは「複数条件による抜き出し問題」だ。
関数で出来ればおなじみのやり方で良いのだが、既に出ているように式が長く複雑で、初心者には何をやって居るかわからない式になる。毎度週に数回このタイプの質問が出て、同じようなタイプの答えになる。Googleででも「imogasi方式」で照会すれば、過去の沢山の例と回答(そのタイプも)が出てくる。
ーー
まず初心者や急ぐ場合はデーターフィルターフィルタオプションの設定で済ませられないか勉強すべきだ。
ーー
本来、こういう仕事の関連のエクセル表...続きを読む

Q条件にマッチする行を抽出するVBAを教えてください

アイデア、またはVBAプログラムの例を教えていただきたく、質問させていただきます

excelで、添付画像のようなリスト管理表を作っています。
リストは600行近くになります。
やりたいことは、D3またはE3に商品名または保管庫を入力すると、リスト内から、合致する行だけが抽出される、というもの。
D3とE3は、どちらか片方にのみ条件が入る。D3とE3の内容を変更するとリアルタイムで抽出結果も変更されるようにしたい。
触る人が初心者なので、難しい作業を一切せずに、D3またはE3を打ちかえるだけで必要な項目だけのリストとなり、印刷するだけでいいようにしたいわけです。

本来ならオートフィルタですればいい話ですが、どうしてもD3という離れたセルの入力内容で抽出したいのです。

VBAでなく、D3のセル内容を使ってD8~のオートフィルタが行えるなら、それが一番理想です。
が、自分でやってみた限りはできませんでした。

フィルタオプションならどうかとやってみたところ、一回目は抽出できました。しかし、D3またはE3の条件を変更しても、リアルタイムで抽出結果が切り変わらない。
フィルタオプションの抽出結果を別のセルに出せばいいのですが、そうすると無駄な情報が残り、ただ印刷しただけでOK・・というわけにいきません。(印刷範囲を区切るとかでなく、シートの見栄えが必要な情報だけにならないと…扱う初心者が混乱します)


自分なりには、VBAにより、 D3・E3のセル内容が書き換わったらフィルタオプションの抽出結果をいったん同シートの別セルに出し、抽出結果部分だけを別のシートにカット&ペースト成形。そのシートを印刷させればよい。
という考えになりましたが、やってみたら、なぜか別のブックに同じものが形成され、抽出した結果だけ単独のデータにできません。

そもそももっと良いアイデアがあればそれをおしえていただきたい。
あるいは、VBAで目的達成できるように問題点をご指摘ください。


一応、プログラムを書いておきます



■添付画像のデータが入っているシート(『一覧』という名前のシート)内コード

Private Sub Worksheet_Change(ByVal Target As Range)
'

If Target.Column = 4 Then
If Target.Row >= 3 And Target.Row <= 3 Then

Call Filter
Call copy

End If
End If

End Sub

■サブルーチンFilter() 標準モジュールに記載
Sub Filter()

' Filter Macro

'フィルタオプションを使って同シート内「D1100」以降に抽出結果を出します
ActiveWorkbook.Worksheets("一覧").Select

'一覧表はD7~F1000。検索条件はD2~F3までの範囲に名前を付けたもの
Range("一覧表").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"検索条件"), CopyToRange:=Range("D1100"), Unique:=False

Range("A1").Select
End Sub


■サブルーチンcopy() 標準モジュールに記載
Sub copy()
'
' copy Macro
'
'抽出された内容(45行目~100行目まで)を別のシートにコピーします

ActiveWorkbook.Worksheets("一覧").Select
Rows("45:100").Select
Selection.Cut
ActiveWorkbook.Worksheets("抽出結果").Select
Rows("4:4").Select
Selection.Insert Shift:=xlDown
Range("A1").Select


End Sub

アイデア、またはVBAプログラムの例を教えていただきたく、質問させていただきます

excelで、添付画像のようなリスト管理表を作っています。
リストは600行近くになります。
やりたいことは、D3またはE3に商品名または保管庫を入力すると、リスト内から、合致する行だけが抽出される、というもの。
D3とE3は、どちらか片方にのみ条件が入る。D3とE3の内容を変更するとリアルタイムで抽出結果も変更されるようにしたい。
触る人が初心者なので、難しい作業を一切せずに、D3またはE3を打ちかえるだけで必要な項目だ...続きを読む

Aベストアンサー

追記:
では、当方で検証したサンプルコードを載せますので、ご参考に。結果提示用に「抽出結果」と名付けたまっさらなシートを予め用意しておいてください。

と、その前に注意点。
ご質問内容では、シートモジュールや標準モジュール等、複数のモジュールにコードが分散していますが、今回の処理内容では、モジュールを分ける意味がありません。シートモジュールのワークシートチェンジイベント1本で十分です。従って、ご案内するコードは、一覧表のあるシートのシート見出しを右クリック→コードの表示から呼び出した画面に書き込み、入力が終わったら、ファイルタブ→終了してexcelに戻る、としてください。

それと、クライテリアを使うと、倉庫1の検索で倉庫10以降もピックアップされてしまうので、1は全角で10以降は半角にするなど、元ネタに区別をしてください。

また、利用者のなかにビギナーがいるのであれば、セルのロックと保護を使い、一覧シートのD3:E3しか操作出来ないようにする、入力規則を使って、商品1,商品2といったリストから選ばせる、等の工夫も考えられます。それらをどう併用するかによって適切なコードも変わってきますので、細部はご自身で調整してください。

Private Sub Worksheet_Change(ByVal Target As Range)

If Application.Intersect(Target, [D3:E3]) Is Nothing Then Exit Sub

Worksheets(”抽出結果”).[A1:C1000].ClearContents

Range(”一覧表”).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range _
(”検索条件”), Copytorange:=Worksheets(”抽出結果”).Range(”A1”)

End Sub

追記:
では、当方で検証したサンプルコードを載せますので、ご参考に。結果提示用に「抽出結果」と名付けたまっさらなシートを予め用意しておいてください。

と、その前に注意点。
ご質問内容では、シートモジュールや標準モジュール等、複数のモジュールにコードが分散していますが、今回の処理内容では、モジュールを分ける意味がありません。シートモジュールのワークシートチェンジイベント1本で十分です。従って、ご案内するコードは、一覧表のあるシートのシート見出しを右クリック→コードの表示から呼...続きを読む

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

エクセル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

QEXCEL VBA データを抽出して別シートへ貼り付ける方法

お世話になります。以下の例のように
元のデータを 品名ごとの別シートに 日付順に並べて 貼り付けられるように
したいのですが、どのようにコードを組めばよいかご教授 頂けないでしょうか。



元データsheet
A列     B列    C列     D列
日付     品名        個数
2/1      りんご       50
2/13     みかん       150
3/22    りんご       75
2/10    りんご       100
3/13    みかん       120


抽出先りんごsheet
A列     B列    C列    D列
日付     品名    個数
2/1     りんご   50
2/10     りんご   100
3/22     りんご   75

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

Aベストアンサー

VBA勉強中と云うことなので、「こんな方法もあるよ」的な回答をさせていただきます。
抽出元を抽出先にコピーして、そこから「りんご」以外を削除するロジックとなっています。
なお、抽出先のシートが存在していないとエラーになります。また、抽出対象の「りんご」が無い場合も、エラーになりますので、必要であれば、notimeさんの方で組み込んでください(勉強の一環として)。

Sub りんご()
Dim ToWs As Worksheet
Dim DifRng As Range
Set ToWs = Worksheets("抽出先りんごsheet")
Worksheets("元データsheet").Columns("A:D").Copy Destination:=ToWs.Columns("A:D")
ToWs.Columns("C").Delete
With ToWs.Range("B2:B" & Rows.Count)
Set DifRng = .Find(What:="りんご", LookIn:=xlFormulas, LookAt:=xlPart)
.ColumnDifferences(DifRng).EntireRow.Delete
End With
ToWs.Range("A:C").Sort key1:=ToWs.Range("A1"), order1:=xlAscending, Header:=xlYes
End Sub

VBA勉強中と云うことなので、「こんな方法もあるよ」的な回答をさせていただきます。
抽出元を抽出先にコピーして、そこから「りんご」以外を削除するロジックとなっています。
なお、抽出先のシートが存在していないとエラーになります。また、抽出対象の「りんご」が無い場合も、エラーになりますので、必要であれば、notimeさんの方で組み込んでください(勉強の一環として)。

Sub りんご()
Dim ToWs As Worksheet
Dim DifRng As Range
Set ToWs = Worksheets("抽出先りんごsheet")
Workshee...続きを読む

Q【VBA】特定の条件でセルをコピー

VBA初心者です
特定の条件を満たすセルの隣接する指定のセルをコピーして別のシートへ貼付けたいです


【sheet1】

A   B   C   ~   F  G

1   2   あ   ~   3  あり
2   1   い   ~   7  なし
3   2   う   ~   4  あり
5   3   え   ~   6  あり
6   2   お   ~   5  なし
7   1   か   ~   3  あり
8   3   き   ~   7  なし
9   2   く    ~  8  なし

といったデータのうち、G列が「あり」の行の
C~Fの値を別のシートへ以下のように貼り付けたいです

【sheet2】

A   ~   D  E

あ   ~   3  _
う   ~   4  _
え   ~   6  _
か   ~   3  _


全くの初心者です
よろしくお願いします

Aベストアンサー

Sheet1がアクティブな時しかうまくいきませんが、
こんな感じでどうでしょう。
適当に作ってるので、非常にパフォーマンス悪いですが・・・。


Public Sub cptest()
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Dim rng As Range
Dim cel As Range
Dim stcrng As New Collection
Dim lastRow As Integer
Dim cnt As Integer
Set sht1 = ThisWorkbook.Worksheets("Sheet1")
Set sht2 = ThisWorkbook.Worksheets("Sheet2")
lastRow = Range("G65535").End(xlUp).Row
Set rng = sht1.Range("G1:G" & lastRow)
For Each cel In rng
If cel.Value = "あり" Then
Set cel = sht1.Range(cel.Offset(0, -4), cel.Offset(0, -1))
stcrng.Add cel
End If
Next

sht2.Cells.Clear
cnt = 0
Set rng = sht2.Range("A1")
For Each cel In stcrng
cel.Copy
rng.Offset(cnt, 0).PasteSpecial
rng.Offset(cnt, 4).Value = "_"
cnt = cnt + 1
Next
Application.CutCopyMode = False
End Sub

Sheet1がアクティブな時しかうまくいきませんが、
こんな感じでどうでしょう。
適当に作ってるので、非常にパフォーマンス悪いですが・・・。


Public Sub cptest()
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Dim rng As Range
Dim cel As Range
Dim stcrng As New Collection
Dim lastRow As Integer
Dim cnt As Integer
Set sht1 = ThisWorkbook.Worksheets("Sheet1")
Set sht2 = ThisWorkbook.Worksheets("Sheet2")
lastRow = Range("G65535").End(xlUp).Row
...続きを読む

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特定の行を選択して別のシートにコピーするマクロ

指定した行と、
特定の文字(複数)がある行を
全て選択し、別のシートにコピーする
マクロをお教えいただけませんか?

 選択したい行は(同じシートで)
 必ず3行目と、
 A列に『ABC』、『DEF』という文字がある全ての行です。


このようなマクロはどのように作ればいいでしょうか?
マクロに詳しい方、お知恵をお貸し頂けませんでしょうか?

Aベストアンサー

補足を読みました。
値としてSheet2に表示すれば良い訳ですね。

前回のコードに手を加えるとすると

Sub Sample4()
Dim lastRow As Long, wS As Worksheet
Set wS = Worksheets("Sheet2")
wS.Cells.Clear
With Worksheets("Sheet1")
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
With .Rows(3 & ":" & lastRow)
.AutoFilter field:=1, Criteria1:="*ABC*", Operator:=xlOr, Criteria2:="*DEF*"
.SpecialCells(xlCellTypeVisible).Copy
wS.Activate
ActiveSheet.Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues
End With
.AutoFilterMode = False
End With
End Sub

こんな感じでしょうか!

尚上記方法はオートフィルタでやっていますので、データ量が多くない場合は
For~Nextでループさせても良いと思います。
参考程度でそのコードは

Sub Sample5()
Dim i As Long, lastCol As Long, wS As Worksheet
Set wS = Worksheets("Sheet2")
wS.Cells.Clear
With Worksheets("Sheet1")
lastCol = .UsedRange.Columns.Count
wS.Range("A1").Resize(, lastCol).Value = .Range("A3").Resize(, lastCol).Value
For i = 4 To .Cells(Rows.Count, "A").End(xlUp).Row
If InStr(.Cells(i, "A"), "ABC") > 0 Or InStr(.Cells(i, "A"), "DEF") > 0 Then
wS.Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(, lastCol).Value = _
.Cells(i, "A").Resize(, lastCol).Value
End If
Next i
End With
End Sub

でも同様の結果になると思います。m(_ _)m

補足を読みました。
値としてSheet2に表示すれば良い訳ですね。

前回のコードに手を加えるとすると

Sub Sample4()
Dim lastRow As Long, wS As Worksheet
Set wS = Worksheets("Sheet2")
wS.Cells.Clear
With Worksheets("Sheet1")
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
With .Rows(3 & ":" & lastRow)
.AutoFilter field:=1, Criteria1:="*ABC*", Operator:=xlOr, Criteria2:="*DEF*"
.SpecialCells(xlCellTypeVisible).Copy
wS.Activate
ActiveSheet.Range("A1").Select
Selection.Paste...続きを読む

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

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

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

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

Aベストアンサー

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

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


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

人気Q&Aランキング