エクセルマクロ Vlookupに似たマクロはありますか？

質問

度々すみません。
わからない事がいくつか出てきてしまって。どなたかご教示いただけると嬉しいです。

今は手作業で以下のような作業をしております。

データ元のシート（以下(1)）とそれ加工して作るシート（以下(2)）があります。
(1)のデータを2度sortするのですが、一度目のsortでtotalが入っている行は全てdelete。
残ったデータでもう一度sortし、種類別に並び変えます。
その後、コラムAがUSDである物はシート(2)のUSDページに貼り付け、コラムAがEURであればシート(2)のEURページに貼り付け・・・としていきたいのですが、マクロの記録を使おうにも、毎回コラムAは目視で確認しコピー・貼り付けをしていますのでマクロの記録は使えないですし、エクセル関数ではVLOOKUPがありますが、それをマクロに書き込む方法もどこにも載っておらず、どうしていいか息詰まった状態です。

sortするのはマクロの記録を使って作成できましたので、
・コラムAがtotalになっている行より下はdelete
・コラムAがUSDならシート(2)のUSDシートへ貼り付け・・・
のマクロを作成したいです。

どうか宜しくお願い致します。

回答No.18

n-jun · ベストアンサー

>12枚のデータ元のページのうち、データがあるもののみtotalに貼り付けたいのですが
>何か使えるマクロはありますでしょうか。

http://okwave.jp/qa4200665.html
のANo.4での回答に類似。
各シートのセルＡ１にデータがある場合コピペする。

Sub　try()
　　Dim　ws1　As　Worksheet
　　Dim　ws2　As　Worksheet
　　Dim　r1　As　Range,　r2　As　Range

　　Set　ws1　=　Worksheets("total")　'纏めるシート
　　Set　r1　=　ws1.Range("A3")

　　ws1.Cells.ClearContents
　　For　Each　ws2　In　Worksheets
　　　　　　　　　　If　ws2.Name　<>　ws1.Name　Then
　　　　　　　　　　　　　If　ws2.Range("A1").Value　<>　""　Then
　　　　　　　　　　　　　　　　With　ws2
　　　　　　　　　　　　　　　　　　　　　　　　　　Set　r2　=　.Range("A1",　.Cells(Rows.Count,　1)　_
　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　.End(xlUp).Resize(,　16))
　　　　　　　　　　　　　　　　End　With
　　　　　　　　　　　　　　　　r2.Copy　r1
　　　　　　　　　　　　　　　　With　r1.Resize(r2.Rows.Count,　16)
　　　　　　　　　　　　　　　　　　　　　　　　　　With　.Borders(xlEdgeLeft)
　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　.LineStyle　=　xlContinuous
　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　.Weight　=　xlMedium
　　　　　　　　　　　　　　　　　　　　　　　　　　End　With
　　　　　　　　　　　　　　　　　　　　　　　　　　With　.Borders(xlEdgeTop)
　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　.LineStyle　=　xlContinuous
　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　.Weight　=　xlMedium
　　　　　　　　　　　　　　　　　　　　　　　　　　End　With
　　　　　　　　　　　　　　　　　　　　　　　　　　With　.Borders(xlEdgeBottom)
　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　.LineStyle　=　xlContinuous
　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　.Weight　=　xlMedium
　　　　　　　　　　　　　　　　　　　　　　　　　　End　With
　　　　　　　　　　　　　　　　　　　　　　　　　　With　.Borders(xlEdgeRight)
　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　.LineStyle　=　xlContinuous
　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　.Weight　=　xlMedium
　　　　　　　　　　　　　　　　　　　　　　　　　　End　With
　　　　　　　　　　　　　　　　End　With
　　　　　　　　　　　　　　　　Set　r1　=　r1.Offset(r2.Rows.Count　+　1)
　　　　　　　　　　　　　End　If
　　　　　　　　　　End　If
　　Next
End　Sub
こうゆう事でしょうか？

お礼

動きはピッタリです。

二点質問があります。

(1)前回のマクロに関してなのですが、通貨毎に、対応する各々のシートに貼り付ける際、値貼りにしたいのです。（コラムAに色が塗ってあり、値貼りにより白字にしているので）
マクロの中にPasteという文言がないのですが、PasteではなくValue　Pasteにするにはどの行を変更すれば宜しいでしょうか？

(2)No18で教えていただいたマクロを走らせると、sheet1の1～2行目に書いてあった文字等が消えてしまっているのですが、マクロの中にdeleteの文言がないのですが、どの行を変更すれば宜しいでしょうか？

本当にすみません。

回答No.4

n-jun

>・コラムAがtotalになっている行より下はdelete
TotalJPYも削除対象としてますが。

　Sub　test()
　　　Dim　wb1　As　Workbook
　　　Dim　wb2　As　Workbook
　　　Dim　r　As　Range
　　　Dim　i　As　Long,　j　As　Long
　　　Dim　m　As　Integer
　　　Dim　v,　vv

　　　Set　wb1　=　Workbooks("Book1.xls")　'転記もと
　　　Set　wb2　=　Workbooks("Book2.xls")　'転記先

　　　With　wb1.Worksheets("Sheet1")
　　　　　　　　v　=　.Range(.[A2],　.Cells(Rows.Count,　1)　_
　　　　　　　　　　　　.End(xlUp).Resize(,　5)).Value
　　　　　　　　ReDim　vv(1　To　UBound(v,　1),　1　To　5)
　　　　　　　　For　i　=　1　To　UBound(v,　1)
　　　　　　　　　　　　If　InStr(v(i,　1),　"total")　=　0　And　_
　　　　　　　　　　　　　　　InStr(v(i,　1),　"Total")　=　0　Then
　　　　　　　　　　　　　　　j　=　j　+　1
　　　　　　　　　　　　　　　For　m　=　1　To　5
　　　　　　　　　　　　　　　　　　　vv(j,　m)　=　v(i,　m)
　　　　　　　　　　　　　　　Next
　　　　　　　　　　　　End　If
　　　　　　　　Next
　　　　　　　　.Range(.[A2],　.Cells(Rows.Count,　1).End(xlUp)　_
　　　　　　　　.Resize(,　5)).ClearContents
　　　　　　　　.Range("A2").Resize(j,　5).Value　=　vv
　　　End　With

　　　For　i　=　1　To　j
　　　　　　　With　wb2.Worksheets(vv(i,　1))
　　　　　　　　　　　　If　.Range("A1")　=　""　Then
　　　　　　　　　　　　　　　Set　r　=　.Range("A1")
　　　　　　　　　　　　Else
　　　　　　　　　　　　　　　Set　r　=　.Range("A"　&　Rows.Count)　_
　　　　　　　　　　　　　　　　　　　　　　　.End(xlUp).Offset(1)
　　　　　　　　　　　　End　If

　　　　　　　　　　　　For　m　=　1　To　5
　　　　　　　　　　　　　　　　r.Offset(,　m　-　1).Value　=　vv(i,　m)
　　　　　　　　　　　　Next

　　　　　　　End　With
　　　Next
　　　Set　r　=　Nothing
　　　Erase　v,　vv
　End　Sub
最終的に基データの並び替えが必要であれば、追加して下さい。
コピーを取ってブック名等を修正して試してみて下さい。

お礼

rr-junさん、前回も教えていただいたのに今回もありがとうございます。

下記マクロを試してみました。

Sub Macro2()

ChDir "R:\"
Workbooks.OpenText Filename:="C:\TD Trade to mark", Origin:=932, StartRow _
:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolonfiltered=True, Comma:=False, _
Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array( _
3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10 _
, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array(16, 1), _
Array(17, 1)), TrailingMinusNumbers:=True
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim r As Range
Dim i As Long, j As Long
Dim m As Integer
Dim v, vv

Set wb1 = Workbooks("R:\CMP\Treasury P&L\P&L\Treas_Trade_to_mark\TD trade to mark")
Set wb2 = Workbooks("R:\CMP\Treasury P&L\P&L\Treas_Trade_to_mark\マクロ sample TD Trade to Mark.xls")
ActiveSheet.Range("A1").Select

ActiveSheet.Range Range("A1").Select
ActiveSheet.Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select.Sort Key1:=Range("H2"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientationfiltered=xlTopToBottom, _
SortMethod:=xlPinYin, DataOption1:=xlSortNormal
ActiveWindow.SmallScroll Down:=138

With　wb1.Worksheets("Sheet1")
以下rr-junさんのマクロをそのままペースト

マクロが走るかしてみたのですが
Dim wb1 As Workbookのところで止まってしまいます。

転記もとのシートは他のシステムよりRドライブに落としたCSVファイルです。

どうすればいいのでしょうか。毎回すみません・・・

回答No.3

nihonjinn

カラムA（列A)での並び替えで一気にできそうな気もするのですが・・・もう少し具体的な内容を知りたいところです。

とりあえずワークシート関数はマクロで
Application.WorksheetFunctionの後に関数を入れて使うことはできます。
Application.WorksheetFunction.VLookup(～)みたいな感じです。
セル範囲の所はRangeやCellを用いてください。

お礼

詳細が伝わらず申し訳ありません。

コラムA　　　　　B　　　　　　C　　　　　D　　　　　E
通貨　　　　番号　　　　　＠＠　　　＠＠　　　　金額

total　　　 Total　　　　 Total　　　Total　　　Total
TotalJPY　　TotalJPY　　　TotalJPY　 TotalJPY TotalJPY
AUD 111 222 121 131000
EUR　　　　 131 151 171 500

というようなシートになっており、これをsortしていきます。
まずTotal行はいらないので並べかえ、最初のtotal行以降を削除します。
次にまたsortで通過毎に並び変えます。

その後、並び変えたデータを違うエクセルワークブック（以下ブック(2)）に貼り付けます。
コラムAがAUDであれば、ブック(2)のAUD（sheet2を自分でRenameした）のシートのA1に貼り付ける、コラムAがEURならブック(2)のEUR（sheet3を自分でRename）のA1に貼り付けるとしていきたいのです。

第一回の並び変えはマクロの記録でやりました。

その後の作業のマクロがわかりません。
・最初のtotal行にセルを持っていくマクロが不明。
・毎回データ数が違う為、AUDをコピーするにも何行目から何行目と決まっていないのでどう処理していいのか不明。

どうぞ宜しくお願い致します。

回答No.2

n-jun

>コラムAがUSDである物はシート(2)のUSDページに貼り付け、
>コラムAがEURであればシート(2)のEURページに貼り付け・・・
シートがどのような状態なのか不明です。
コラムＡと言われても・・・？？？な感じです。
回答者側はブックは見ることが出来ませんので、その情報を提示された方が
良いかと思いますけど。

お礼

詳細が伝わらず申し訳ありません。

コラムA　　　　　B　　　　　　C　　　　　D　　　　　E
通貨　　　　番号　　　　　＠＠　　　＠＠　　　　金額

total　　　 Total　　　　 Total　　　Total　　　Total
TotalJPY　　TotalJPY　　　TotalJPY　 TotalJPY TotalJPY
AUD 111 222 121 131000
EUR　　　　 131 151 171 500

というようなシートになっており、これをsortしていきます。
まずTotal行はいらないので並べかえ、最初のtotal行以降を削除します。
次にまたsortで通過毎に並び変えます。

その後、並び変えたデータを違うエクセルワークブック（以下ブック(2)）に貼り付けます。
コラムAがAUDであれば、ブック(2)のAUD（sheet2を自分でRenameした）のシートのA1に貼り付ける、コラムAがEURならブック(2)のEUR（sheet3を自分でRename）のA1に貼り付けるとしていきたいのです。

第一回の並び変えはマクロの記録でやりました。

その後の作業のマクロがわかりません。
・最初のtotal行にセルを持っていくマクロが不明。
・毎回データ数が違う為、AUDをコピーするにも何行目から何行目と決まっていないのでどう処理していいのか不明。

どうぞ宜しくお願い致します。

回答No.1

hana-hana3

＞一度目のsortでtotalが入っている行は全てdelete。
＞毎回コラムAは目視で確認しコピー・貼り付けをしていますので

いずれも、オートフィルタを使えば抽出出来ますし、記録マクロに出来ます。

お礼

詳細を記入しなかった為、誤解を招きすみません。
出来ることはマクロの記録で対応しました。

その後が下記の理由でわからないので、ご存知であればご教示いただけると嬉しいです。

コラムA　　　　　B　　　　　　C　　　　　D　　　　　E
通貨　　　　番号　　　　　＠＠　　　＠＠　　　　金額

total　　　 Total　　　　 Total　　　Total　　　Total
TotalJPY　　TotalJPY　　　TotalJPY　 TotalJPY TotalJPY
AUD 111 222 121 131000
EUR　　　　 131 151 171 500

というようなシートになっており、これをsortしていきます。
まずTotal行はいらないので並べかえ、最初のtotal行以降を削除します。
次にまたsortで通過毎に並び変えます。

その後、並び変えたデータを違うエクセルワークブック（以下ブック(2)）に貼り付けます。
コラムAがAUDであれば、ブック(2)のAUD（sheet2を自分でRenameした）のシートのA1に貼り付ける、コラムAがEURならブック(2)のEUR（sheet3を自分でRename）のA1に貼り付けるとしていきたいのです。

第一回の並び変えはマクロの記録でやりました。

その後の作業のマクロがわかりません。
・最初のtotal行にセルを持っていくマクロが不明。
・毎回データ数が違う為、AUDをコピーするにも何行目から何行目と決まっていないのでどう処理していいのか不明。

どうぞ宜しくお願い致します。