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

マスタシートには、各店舗の累積データが入っており、日々データが追加されております。

毎日の作業として、
1.マスタシートを、各店舗別シートにコピーをする。(シート名は店舗コード)*マクロで自動化済
2.各店舗別シートの、特記事項を修正。*手作業
3.修正した行を、マスタシートの対象行に上書き。*手作業
4.修正した行のみ、修正データシートへ貼り付け。*手作業

3と4の手作業を自動化しようと、データの通番(A列)と、特記事項(P列)をキーにして、
Dictionaryを使い、一致しないデータを抽出しようとやってみましたが、
うまくいかず悩んでおります。

データには、通番・店舗コード・店舗名・特記事項などがあります。

何か良い方法があったら、教えて下さい。宜しくお願いします。

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

A 回答 (1件)

こういう仕事関係の(単一課題でない)問題の質問は、簡単な実例でも挙げて説明してもらわないと、回答者が時間をかけて推測して、理解せねばならない。

画面も見られず、今始めて考えさせられる事項なんだから。質問する側はその辺考えてほしい。
ーーー
まず(本件考えている)シートは2つあります
(A)マスターシート(名前は?質問では仮にでもつけること)
(B)店舗別シート(シート名は店舗コード)
(A)から(B)を点別に振り分けて作成(この作業はVBAで済み)
ーー
特記事項という文字情報を、店舗別シートのある列に入力。(どの列?質問では仮にでもつけること)。ここは自動化しようが無い。
ーー
店舗別シートに入れた情報を、マスタに反映させたい。
全店舗入力済み後まとめて転記でいいのですね(バッチ作業)
ただマスタには1店舗情報は1行なのか?(この点当然ではない。質問に書くべき)
1行(ユニーク)なら、
シート名(ほかにも店舗コードはシート名内のセルにあるのでは。書くべき。普通はデータはセル値から採る)
ーー>マスタの店舗コード行を検索ーー>所定の列・セル(列がどこか?質問には書いてない)に特記事項を代入
で良いのかな
ーー
>修正した行のみ、修正データシートへ貼り付け
突然>修正データシートというシートが出てきているが、どういうものか。私の当初2シートと思ったのは誤りか。
初めに3シートを問題にしますと書くこと。
ーー
>Dictionaryを使い、一
VBScpitなんか勉強したのかな。その点進んでいるのですね。
であれば
店舗シートで決まる店舗コードでFindメソッドでマスタの該当行を(ユニークとして)探せば済むだけの話ではないの。
ーーーー
ただ少し長期的に見た場合、
店舗の増加
第2、第3・・の特記事項の追加があったときどう見つけるのかな。
現状の直前状態の店舗シートの状態データでマスタ特記事項部は全部置き換えするのか。
ーー
仕事関連のまとまった1作業を質問を他人に判らせるということが文章では大変だということを再認識のこと。
======
色々言ったが
店舗シートで決まる店舗コードで、マスタの店舗コード列を、Findメソッドで、該当行を(ユニークとして)探せば特記事項を転記すべき行がわかるのでは。
実情と私の理解が違う点も含めてコメントください。
例データ
店舗コード
112321
112322
112325
ーー
Sub test01()
Dim r As Range
Set r = Worksheets("Sheet1").Range("A2:A50").Find(112322)
MsgBox r.Row
r.Offset(0, 2) = "社長ワンマン、優良先"
End Sub

この回答への補足

解りづらい質問の仕方をしてしまい、大変に申し訳ありませんでした。
また様々な指摘有難うございます。

詳しく説明させて頂きます。(更にわかりづらくなってしまったらスミマセン)
1.シートは[マスタ]シート、[店舗別]シート、[修正データ]シートの3種類があります。但し、[店舗別]シートというのは店舗数分存在します。
店舗は日々増加している為、[店舗別]シートの数は日々変わります。シート名は、店舗コード(数字6桁)を使用しています。

2.[マスタ]シートの項目は、通番・店舗コード・店舗名・TEL・PCNO・処理結果・特記事項などがあります。
日々実施されている、各店舗のパソコンへのアップデートの処理結果の累積表になっているため、1店舗情報は数行(日数分)存在します。

3.特記事項には、店舗への確認情報を記入しております。

4.店舗数が数十件あるため、[マスタ]シートから、店舗コードごとに抽出をして、店舗コードごとにシートを作り、内容を修正しています。

この後、修正した行のみを、通番(A列)と特記事項(P列)をキーにして、[マスタ]シートの同じ通番に上書きすると共に、[修正データ]シートに修正した行をコピーしたいと思っております。

同じシート内で、A,B列とC,D列を比較し、一致しないデータを抽出し、E,F列に表示するという以下の方法を、ネットでみつけました。
これを応用し、[マスタ]シートのA列(通番)とP列(特記事項)をキーにして、各店舗別シートを1つのシートに纏め、A列(通番)とP列(特記事項)を比較し、一致しないデータの抽出をしようと試みましたが、うまくいかず何か他に良い方法はないかと思い、質問させてもらいました。

説明が長くなってしまい、申し訳ありません。
何か良い方法がありましたら、ご教授願います。

---------------------------------------------------------
Dim v,w,ky,i&,ss$
Dim dic As Object

v=Range("A2",Range("A1").End(xlDown)).Resize(,2).Value
w=Range("C2",Range("C1").End(xlDown)).Resize(,2).Value
Set dic=CreateObject("Scripting.Dictionary")

For i=1 To UBound(v)
ss=v(i,1) & "|" & v(i,2)
dic(ss)=Empty
Next

For i=1 To Ubound(w)
ss=w(i,1) & "|" & w(i,2)
If dic.Exists(ss) Then
dic.Remove ss
End If
Next

ReDim v(1 To dic.Count,1 To 2)
i=0

For Each ky In dic.Keys
i=i+1
w=Split(ky,"|")
v(i,1)=w(0)
v(i,1)=w(1)
Next
Range("E2").Resize(dic.Count,2).Value=v
Set dic=Nothing
---------------------------------------------------------

補足日時:2008/03/24 00:55
    • good
    • 0

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

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

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

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

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

QExcelVBAでデータ不一致のものの抽出

単純なものにしたいので教えてください。
Sheet1「元データ」              
   A   B    C   D  
コード 商品  店名  納入日  
1 0001 みかん  A店  3/1 
5 0360 メロン  D店
6 かき   P店
7 0312 キウイ  D店
9 0333 くり C店
Sheet2「最新データ」
  A   B    C   D
コード 商品  店名  納入日 
1 0001 みかん  A店  3/1
4 0311 いちご B店  3/10
6 0250
8 0312 キウイ   
とあった時に元データのA列の番号と最新データの番号を見て同じ物があったら、元データに最新データの内容をうつし込み、一致しなかったらチェックデータへうつしこむというデータがあります。
Dim Sh1 As Worksheet
Dim Sh2 As Worksheet
Dim Sh3 As Worksheet
Dim myR As Range
Dim N_D As Long
Dim i As Long
Set Sh1 = Worksheets("元データ")
Set Sh2 = Worksheets("チェックデータ")
Set Sh3 = Worksheets("最新データ")
With Sh1
For i = 5 To .Range("A65536").End(xlUp).Row
N_D = .Range("E" & i).Value
Set myR = Sh3.Range("A:A").Find(What:=N_D, LookIn:=xlValues, _
MatchCase:=False)
If Not myR Is Nothing Then
myR.Offset(, 2).Resize(, 3).Copy _
Destination:=.Range("B" & i & ":D" & i)
Else
addR_No = Sh2.Range("A65536").End(xlUp).Row + 1
.Range("A" & i & ":D" & i).Copy _
Destination:=Sh2.Range("A" & addR_No & ":D" & addR_No)
End If
Next
End With
ここで、データが一致した場合は無視して、一致しなかったときだけチェックデータに内容を書き込むとする場合はどのように修正すればよいのでしょうか?あと、チェックデータのあたまに
コード 商品  店名  納入日 
という言葉を入れたいのですが、どのように書き込むのでしょうか?

単純なものにしたいので教えてください。
Sheet1「元データ」              
   A   B    C   D  
コード 商品  店名  納入日  
1 0001 みかん  A店  3/1 
5 0360 メロン  D店
6 かき   P店
7 0312 キウイ  D店
9 0333 くり C店
Sheet2「最新データ」
  A   B    C   D
コード 商品  店名  納入日 
1 0001 みかん  A店  3/1
4 0311 いちご B店  3/10
6 0250
8 0312 キウイ   
とあった時に元データのA列の番...続きを読む

Aベストアンサー

>ここで、データが一致した場合は無視して、一致しなかったときだけチェックデータに
>内容を書き込むとする場合はどのように修正すればよいのでしょうか?
If Not myR Is Nothing Then
  myR.Offset(, 2).Resize(, 3).Copy _
  Destination:=.Range("B" & i & ":D" & i)
Else
  addR_No = Sh2.Range("A65536").End(xlUp).Row + 1
  .Range("A" & i & ":D" & i).Copy _
  Destination:=Sh2.Range("A" & addR_No & ":D" & addR_No)
End If

を以下のように変更

If myR Is Nothing Then
  addR_No = Sh2.Range("A65536").End(xlUp).Row + 1
  .Range("A" & i & ":D" & i).Copy _
  Destination:=Sh2.Range("A" & addR_No & ":D" & addR_No)
End If

>あと、チェックデータのあたまに
>コード 商品  店名  納入日 
>という言葉を入れたいのですが、どのように書き込むのでしょうか?
始めにコード 商品  店名  納入日を入力しておけば、特にプログラムで設定する必要は無いと思いますが、あえてやるなら

Set Sh3 = Worksheets("最新データ") の直後の行に
If Sh3.Range("A1").Value <> "コード" Then
  Sh3.Rows(1).Insert
  Sh3.Range("A1").Value = "コード"
  Sh3.Range("B1").Value = "商品"
  Sh3.Range("C1").Value = "店名"
  Sh3.Range("D1").Value = "納入日"
End If

あと余計なお世話でしょうが、元データと最新データの比較という場合、最新データが元データにあるかチェックするのが普通だと思いますが、今のマクロでは元データが最新データに存在するかどうかのチェックになっていますが、これが実現したいことなのでしょうか?

>ここで、データが一致した場合は無視して、一致しなかったときだけチェックデータに
>内容を書き込むとする場合はどのように修正すればよいのでしょうか?
If Not myR Is Nothing Then
  myR.Offset(, 2).Resize(, 3).Copy _
  Destination:=.Range("B" & i & ":D" & i)
Else
  addR_No = Sh2.Range("A65536").End(xlUp).Row + 1
  .Range("A" & i & ":D" & i).Copy _
  Destination:=Sh2.Range("A" & addR_No & ":D" & addR_No)
End If

を以下のように変更

If myR Is Nothing Then ...続きを読む

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....続きを読む

QExcelで[表1]にあって、[表2]にないものを抽出する関数

Excelで[表1]にあって、[表2]にないものを抽出する関数

例)[表1]   [表2]
   A社     A社
   D社     D社
   R社     P社
   P社     R社
   D社
   F社
   F社

上記は簡単に書きましたが、表1に重複するものも含め、300社程度あるなかで
表2にリストアップされていない会社を見つける関数やその他方法論があれば
ぜひ教えてください!
(例でいえば、F社を見つける方法です。)

抽出するのは別シートでも、同じシートでも構いません。

Excel2003でも対応できるものであれば、なお嬉しいです。

よろしくお願いします。

Aベストアンサー

Countif関数で同じものがいくつあるか数えさせます。
   A   B        C
  [表1]表2にある数   [表2]
   A社          A社
   D社          D社
   R社          P社
   P社          R社
   D社
   F社
   F社
だとして
B列に =Countif(C:C,A2)
と入れて下までコピィすれば 表2に同じものがいくつあるか出ますので
0 がないものです。

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方式」で照会すれば、過去の沢山の例と回答(そのタイプも)が出てくる。
ーー
まず初心者や急ぐ場合はデーターフィルターフィルタオプションの設定で済ませられないか勉強すべきだ。
ーー
本来、こういう仕事の関連のエクセル表...続きを読む

QVBAで条件が一致する行のデータを別シートに抽出

"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


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

Aベストアンサー

こんばんは。

#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


 

こんばんは。

#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
...続きを読む

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列の不一致を知りたいです】

初めまして。
お忙しい中、大変申し訳ございませんが、下記に関して、ご指導のほど、宜しくお願い致します。

***************
【例】
A列    B列

あめ    チョコ
ガム    ポテトチップス
チョコ   あめ
       ガム


という列があり、A列はA1000まで続き、B列はB3000まで続きます。
必ずしも、A列の横に同じお菓子名があるわけではありません。

そこで、A列とB列を比較し、B列にしかないもの(上記「例」ではポテトチップス)のセルに色づけ、もしくはC列に、不一致するものだけ「NG」等が記載される数式を教えてください。

お忙しい中、大変申し訳ございませんが、
何卒宜しくお願い申し上げます。

Aベストアンサー

条件付書式で、B列のセルに
「数式が」
=ISERROR(VLOOKUP(B1,A:A,1,FALSE))
で書式を設定し下にコピーすると、無いものだけが書式変更されます。

同じように、B列の隣のC列に
=IF(ISERROR(VLOOKUP(B1,A:A,1,FALSE)),"NG","")
として下にコピーしても隣にNGと表示できます。

QExcel VBA A列が特定の値以外の場合、その行を削除

教えてください。

A列の値が特定の値以外の場合、
その行を行ごと削除する方法はありますでしょうか?
A列には、
1 タイトル
2 (ブランク)
3 a
4 a
5 b
6 b
7 c
8 c
9 d
10 d
~というふうに2000行辺りまで続きます

例えば、A列の3行目以降の値が b 以外の場合、
3・4・7・8・9・10行を行ごと削除する、ということです。

あまり説明が上手でなくて申し訳ありませんが、よろしくお願いします。

Aベストアンサー

ではVBAのサンプルです。コメントも入れておきました。

Sub test01()
With ActiveSheet 'アクティブなシートについて
x = .UsedRange.Cells(.UsedRange.Count).Row 'xに最終行を取得
For i = x To 3 Step -1 '最終行から3行目まで下から順に
If .Cells(i, 1) <> "b" Then .Rows(i).Delete 'A列が"b"でなかったら削除
Next '繰り返し
End With
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条件にマッチする行を抽出する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本で十分です。従って、ご案内するコードは、一覧表のあるシートのシート見出しを右クリック→コードの表示から呼...続きを読む


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

人気Q&Aランキング