Vlookupマクロの初心者による挑戦！お助けください！
- 初心者がエクセルのVlookupマクロを使って値を検索しようとしているがうまくいかない
- 質問者はA列に値がある限りカウントアップしていき、Vlookupを使ってSheet2のA:Fの範囲から値を取得したい
- 質問者が考えたマクロは動かないため、助けを求めている
- ベストアンサー
Vlookupマクロにつきまして
初心者で、 エクセルのマクロにて、下記の処理を行おうとしているのですが、 上手く行きません。 どなたかお助けください！ B3=Vlookup(A3,Sheet2!A:F,3,False) B4 A4 B5 A5 とA列に値がある限りカウントアップしていきます。 以下の通り考えてみたのですが、動きません。 Sub vlookup() Dim i As Long For i = 3 To Cells(Rows.Count, "A").End(xlUp).Row Cells(i, "B") = Application.WorksheetFunction.VLookup(Range(Cells(i, "A")), Worksheets("Sheet2").Range("A:F"), 3, False) Next End Sub すみません、宜しくお願いします。
- yuki_yt_ats
- お礼率50% (1/2)
- オフィス系ソフト
- 回答数1
- ありがとう数1
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
こんばんは！ RANGEプロパティとCELLSプロパティを重複して記述しているので、 ちゃんと動作してくれないと思います。 ＞.VLookup(Range(Cells(i, "A")), の行を >vlookup(Cells(i, "A") とするか、もしくは ＞vlookup(Range("A" & i) のようにしてみてください。m(_ _)m
関連するQ&A
- VBAでVlookup関数を組もうとしていますがエラーが出ます。VBAに詳しい方、教えてください
VBAでvlookup関数を下のように組みましたが、(1)でエラーが出ます。VBAに詳しい方、教えてください。 Sub VLLOKUPによる表の検索4() Dim mykensakuchi Dim mykensakuhan Dim gyo As Integer (1) mykensakuchi = Worksheets("sheet1").Range("a" & gyo).Value mykensakuhan = Worksheets("sheet2").Range("b2:e9") saikagyo = Worksheets("sheet1").Range("a" & Rows.Count).End(xlUp).Row gyo = 2 For gyo = saikagyo To 1 Step -1 With Application.WorksheetFunction Range("b:gyo").Value = .VLookup(mykensakuchi, mykensakuhan, 2, False) End With Next End Sub
- ベストアンサー
- オフィス系ソフト
- VLookupで一致しなかった時のVBAでの処理
On Error ～を使わないで、 VLookup()で一致しなかった時の処理をさせたいのですが どのように記述すればよいでしょうか。 例えば、以下のようなコードの場合、 一致したデータがない時にyに-1を代入するには 以下のコードをどのように記述すればよいのでしょうか。 --------------------- Dim x As Integer Dim y As String x = 7 y = Application.WorksheetFunction.VLookup(x, Worksheets("Sheet1").Range("A1:B100"), 2, False) --------------------- 以下はいずれもエラーになりますが、以下のような感じで処理がしたいです。 --------------------- If IsError(Application.WorksheetFunction.VLookup(x, Worksheets("Sheet1").Range("A1:B100"), 2, False)) Then y = -1 Else y = Application.WorksheetFunction.VLookup(x, Worksheets("Sheet1").Range("A1:B100"), 2, False) End If --------------------- If Application.WorksheetFunction.IsNA(Application.WorksheetFunction.VLookup(x, Worksheets("Sheet1").Range("A1:B100"), 2, False)) Then y = -1 Else y = Application.WorksheetFunction.VLookup(x, Worksheets("Sheet1").Range("A1:B100"), 2, False) End If --------------------- y = Application.WorksheetFunction.IfError(Application.WorksheetFunction.VLookup(x, Worksheets("Sheet1").Range("A1:B100"), 2, False), -1) --------------------- なお、以下のように本来エラーではない処理で On Error Resume Nextを使うのは、 本当のエラーの処理と混同するため不可 --------------------- On Error Resume Next y = Application.WorksheetFunction.VLookup(x, Worksheets("Sheet1").Range("A1:B100"), 2, False) If Err <> 0 Then y = -1 On Error GoTo 0 ---------------------
- ベストアンサー
- Excel（エクセル）
- VBA CHANGEイベントに複数イベントを
いつもお世話になっています。 色々しらべて試してみたんですが、うまくいかないんで教えてください。 CHANGEイベントに複数のイベントを書き込みたいんですが。 今現在、問題なく動いている以下のイベントがあります。 (1) Private Sub Worksheet_Change(ByVal Target As Range) Dim rang3 As Range Dim rang4 As Range Dim ■■ As String Dim LastRow1 As Long LastRow1 = Worksheets("○○").Cells(Rows.Count, "b").End(xlUp).Row Set rang4 = Worksheets("○○").Range("b:I" & LastRow) Set rang3 = Range("h4") If Intersect(Target, rang3) Is Nothing Then Exit Sub On Error Resume Next ■■ = WorksheetFunction.VLookup(Target.Value, rang4, 2, 0) If Err.Number > 0 Then MsgBox Target.Value & "はありません。基本情報台帳に入力してください。" Range("h4").Select Else Application.EnableEvents = False Range("I4").Value = Application.WorksheetFunction.VLookup(Target, Worksheets("△△").Range("b:I"), 2, False) Range("j4").Value = Application.WorksheetFunction.VLookup(Target, Worksheets("△△").Range("b:I"), 3, False) Range("k4").Value = Application.WorksheetFunction.VLookup(Target, Worksheets("△△").Range("b:I"), 7, False) Range("l4").Value = Application.WorksheetFunction.VLookup(Target, Worksheets("△△").Range("b:I"), 8, False) Range("m4").Value = Application.WorksheetFunction.VLookup(Target, Worksheets("△△").Range("b:I"), 5, False) Application.EnableEvents = True Range("K4").Select End If End Sub このシートにもう一つ、イベントを入れたいのですが。 (2) If Target.Count > 1 Then Exit Sub If Intersect(Target, Range("E4")) Is Nothing Then Exit Sub Else If Range("e4").Value = "1" Then Target.Offset(0, 19).Value = "☆" End If どこに入れればいいのかわかりません。 (3) また、(2)のイベントの他に、 (1)のＶＬＯＯＬＵＰが実行され、尚且つ(2)のイベントのＥ４が値が１だった場合、Ｙ４にＨ４の値を入れたいのですが・・・。 (2)のみなら動くことは確認できましたが、(1)のｅｘｉｔ ｓｕｂ の直前に入れたり、ｅｎｄ ｉｆの前に入れたりしましたが、片方は動くが、もうひとつが動かないです。 (3)については、まったくわかりません。 マクロについて、自分でネットで勉強した程度なので、基本がわかっていないからなのでしょうが・・・。 どなたか、教えてください。 お願いします。
- ベストアンサー
- Visual Basic
- Excelマクロのことで教えて下さい
初歩的なことですみません。 E列の値をF列に値を入れるために下記のマクロを組みました。 Sub test() Worksheets("Sheet1").Select Dim i As Long For i = 2 To Cells(Rows.Count, 4).End(xlUp).Row Range("F2").Value = "=E2/1024/1024" Cells(i, 6).FillDown Range(Cells(2, 6), Cells(i, 6)).Copy Range("F2").PasteSpecial Paste:=xlValues Next i End Sub ところがF列に「値のみを貼り付け」をした時に、途中から同じ値のみがコピーされてしまい困っています。 （画像参照） うまく貼り付けることができるマクロをお教え下さい。 よろしくお願いいたします。
- ベストアンサー
- Excel（エクセル）
- マクロでVLookupが出来ません。
マクロでVLookupが出来ません。 A列からE列までデータがあるシート1のA,B,C列の値が全て一致する シート2の行削除をしたいです。 2000行中500行残るはずのダミーで実験してますが全行削除されてしまいます。 Do Until Cells(Line, 6).Value →6の部分を1 VLookup(Cells(Line, 6) →6の部分を1にすれば 500行残ります。ですがこれでは検索値がA列のみの値です。 またそれぞれ1→2、1→3、1→4にしても同じく全行消えこんがらがってます。 シート1のA列のみ検索しているような動きです。どこを修正すればいいのでしょうか？ Sub 行削除() 'シート１→8月シート２→9月 Sheets("8月").Select Range("F2").Select ActiveCell.FormulaR1C1 = "=RC[-5]&RC[-4]&RC[-3]" Selection.AutoFill Destination:=Range("F2:F10000") Sheets("9月").Select Range("F2").Select ActiveCell.FormulaR1C1 = "=RC[-5]&RC[-4]&RC[-3]" Selection.AutoFill Destination:=Range("F2:F10000") '検索する対象値があるシート選択 Sheets("9月").Select 'そのシートの検索開始の行数を選択2行目。 Line = 2 'そのシートの検索値の列指定6=F列。セルF2の値が検索したい値。 'その値がなくなったら検索を終了させる.Value = ""を追加。 Do Until Cells(Line, 6).Value = "" 'エラーとなっても次に進む On Error Resume Next '検索結果を記入する列を指定。Line7=G列（※１） '検索する値があるシートとその列を指定 'VLookup(Cells(Line, 6)の部分。6=F列 '検索されるシートと検索範囲を指定 'Worksheets("9月").Range("A2:F10000")→セルA2からセルF10000まで '検索されたらその行のどの列の値を結果とするのか指定 1=A列 '検索方法指定0=FALSE完全一致。 Cells(Line, 7).Value = Application.WorksheetFunction.VLookup(Cells(Line, 6)_ .Value, Worksheets("8月").Range("A2:F10000"), 1, 0) 'VLOOKUP関数が終了又はエラーが発生したら止まる On Error GoTo 0 '検索されなかったときの処理 '上記（※１）の部分Line7=G列に値がない If Cells(Line, 7).Value = "" Then 'Line7=M列に無と表示 Cells(Line, 7).Value = "無" End If '2行目から開始なので次の行の値を検索値とする Line = Line + 1 '検索する値がなくなるまで繰返す Loop '1行目が削除されるのを防止セルG1に無とセット Sheets("9月").Select Range("G1").Select ActiveCell.FormulaR1C1 = "無" 'データの最終行の行番号を保持する変数 Dim RwMax As Long '現在処理中の行番号を保持する変数 Dim Rw As Long '対象となるシートを選択。 Worksheets("9月").Select 'データの最終行の行番号を取得。 'Count, 7=G列 においてデータが入っている一番下のセルの行番号 RwMax = Cells(Rows.Count, 7).End(xlUp).Row '最終行から１行目まで繰返し処理。 '行の削除の為下から上へと処理。 For Rw = RwMax To 1 Step -1 '値が無ならそのまま If Cells(Rw, 7).Value = "無" Then Cells(Rw, 7).Value = "無" '無でなかったら行削除 Else Rows(Rw).Delete End If Next Rw 'シート2のF,G列を列削除 Sheets("9月").Select Columns("F:G").Select Application.CutCopyMode = False Selection.Delete Shift:=xlToLeft End Sub
- ベストアンサー
- オフィス系ソフト
- VBA 検索するSheetの位置の変更
現在、グループの数だけユーザー名の合計数をSheet2に抽出するという 事をやっているのですが....... コードの方は下記になります Sub Sample3() Dim i As Long, j As Long, k As Long, lastRow As Long, lastCol As Long Dim wS2 As Worksheet, wS3 As Worksheet Set wS2 = Worksheets("Sheet1") Set wS3 = Worksheets("Sheet2") Application.ScreenUpdating = False If wS2.Range("Y1") = "" Then wS2.Range("Y1") = "ダミー" End If With Worksheets("Sheet1") If .Range("A4") = "" Then .Range("A4") = "ダミー" End If lastRow = .Cells(Rows.Count, "B").End(xlUp).Row Range(.Cells(5, "B"), .Cells(lastRow, "B")).AdvancedFilter Action:=xlFilterCopy, copytorange:=wS3.Range("A1"), unique:=True '★ For i = 2 To wS3.Cells(Rows.Count, "A").End(xlUp).Row wS2.Cells(7, (i - 2) * 8 + 3) = wS3.Cells(i, "A") .Range("A4").AutoFilter field:=2, Criteria1:=wS3.Cells(i, "A") Range(.Cells(5, "AA"), .Cells(lastRow, "AA")).SpecialCells(xlCellTypeVisible).Copy wS2.Cells(7, (i - 2) * 8 + 2) For k = wS2.Cells(Rows.Count, (i - 2) * 8 + 2).End(xlUp).Row To 7 Step -1 wS2.Cells(k, (i - 2) * 8 + 3) = WorksheetFunction.CountIfs(.Range("AA:AA"), wS2.Cells(k, (i - 2) * 8 + 2), .Range("B:B"), _ wS2.Cells(7, (i - 2) * 8 + 3)) If WorksheetFunction.CountIf(wS2.Columns((i - 2) * 8 + 2), wS2.Cells(k, (i - 2) * 8 + 2)) > 1 Then wS2.Cells(k, (i - 2) * 8 + 2).Resize(, 2).Delete shift:=xlUp End If Next k Next i wS2.Range("B1").CurrentRegion.Borders.LineStyle = xlContinuous wS2.Cells.Replace what:="ダミー", replacement:="", lookat:=xlWhole .Cells.Replace what:="ダミー", replacement:="", lookat:=xlWhole wS3.Cells.Clear .AutoFilterMode = False End With Application.ScreenUpdating = True End Sub このコードで検索をかけるSheet1のセルBの文字をセルCに移動して検索かけたいという事なのですが、下記の用なコードでBをCに変更してみた結果エラーが発生してしまいます。 lastRow = .Cells(Rows.Count, "C").End(xlUp).Row Range(.Cells(5, "C"), .Cells(lastRow, "C")).AdvancedFilter Action:=xlFilterCopy, copytorange:=wS3.Range("A1"), unique:=True '★ For i = 2 To wS3.Cells(Rows.Count, "A").End(xlUp).Row wS2.Cells(7, (i - 2) * 8 + 3) = wS3.Cells(i, "A") .Range("A4").AutoFilter field:=2, Criteria1:=wS3.Cells(i, "A") Range(.Cells(5, "AA"), .Cells(lastRow, "AA")).SpecialCells(xlCellTypeVisible).Copy wS2.Cells(7, (i - 2) * 8 + 2) For k = wS2.Cells(Rows.Count, (i - 2) * 8 + 2).End(xlUp).Row To 7 Step -1 wS2.Cells(k, (i - 2) * 8 + 3) = WorksheetFunction.CountIfs(.Range("AA:AA"), wS2.Cells(k, (i - 2) * 8 + 2), .Range("C:C"), _ どなたかご教授の方お願い致します。
- ベストアンサー
- Visual Basic
- VBAマクロがうまく動きません
こんにちは。いつもお世話になっております。 掲題の通りなのですが、下記のマクロを作り、 あるブック(毎回異なります)の全シート(毎回名前も数も異なります) に対して、同じ作業をしてほしいのですが、 1シート目で止まってしまいます。 特にエラー表示も出ないので、何が違っているのか わからず、どのように修正をしたらよいか、ご教示いただければ 幸いです。 エクセル2010を使用、パーソナルブックにマクロ登録しています。 Sub Test() Dim i As Integer ' 現在のブックのシート数を取得 For i = 1 To ThisWorkbook.Worksheets.Count '保護解除 Worksheets(i).Unprotect Password:="" '非表示列を表示 Worksheets(i).Columns.Hidden = False 'A列挿入数式コピー、オートフィル Worksheets(i).Columns(1).Insert Range("A12") = "=B12&C12" Range("A12").AutoFill Destination:=Range("A12:A" & Range("D" & Cells.Rows.Count).End(xlUp).Row), Type:=xlFillCopy Next i End Sub よろしくお願い致します。
- ベストアンサー
- Excel（エクセル）
- ExcelマクロでVLOOKを実行したい
ExcelマクロでVLOOKを実行したい 同一シートにある「全体」の表から必要な項目をVLookで抜き出したくて 下記のマクロを作成しました。 「Sheet1」のA列（A2以下）には検索値（数字6ケタ）を入れています。 A2の検索値でヒットした値はB2・C2に入りましたが、A3以下の検索値は スルーされてしまいます。どこを直したら良いのか、ご教授ください。 よろしくお願いします。 ----------------------------------------------------------------------- Sub 検索して値を取得する() Dim 範囲 As Range Dim 検索値, i As Long Dim 出荷日 As Date Dim 商品名 As String Set 範囲 = Worksheets("全体").Range("E7:HG1000") Set 検索値 = Worksheets("Sheet1").Cells(i + 2, 1) If 検索値.Value <> "" Then 商品名 = Application.WorksheetFunction.VLookup(検索値, 範囲, 2, False) 出荷日 = Application.WorksheetFunction.VLookup(検索値, 範囲, 160, False) Cells(i + 2, 2).Value = 商品名 Cells(i + 2, 3).Value = 出荷日 i = i + 1 End If End Sub
- ベストアンサー
- オフィス系ソフト
- エクセル 同じ内容行削除マクロ 2
シート1、シート2（基準）のB列を比較して同じ内容行を削除したいのですが、「栃木県3」と「＃栃木県3」を同じのもと考えて削除されてしまいます。 Sub 削除() Dim wh1 As Worksheet Dim wh2 As Worksheet Dim f As Range Dim wR As Integer Dim mR As Long Dim wStr As String ' Set wh1 = Worksheets("Sheet1") Set wh2 = Worksheets("Sheet2") wR = 0 With wh1 mR = .Cells(Rows.Count, "A").End(xlUp).Row For wR = mR To 1 Step -1 wStr = .Cells(wR, "B") Set f = wh2.Range("B1:B" & wh2.Cells(Rows.Count, "B").End(xlUp).Row).Find(wStr) If Not f Is Nothing Then .Rows(wR).Delete End If Next End With End Sub 解決策教えて下さい。
- ベストアンサー
- オフィス系ソフト
- VBA 変数について
VBA初心者でございます。 VBAでgrpという変数を設定し、それをキーにしてオートフィルタをしたいです。 以下のコードではエラーがでてしまうのは、なぜでしょうか？ どうぞ宜しくお願いいたします。 Sub 絞り込み2() Dim grp Set grp = Worksheets("リスト").Cells(3, 2) Worksheets("マスタ0701").AutoFilterMode = False With Worksheets("マスタ0701").Range(Cells(3, "B"), Cells(Rows.Count, "CK").End(xlUp)) .AutoFilter Field:=13, Criteria1:=grp '.CurrentRegion.Select Range(Cells(3, "B"), Cells(Rows.Count, "CK").End(xlUp)).SpecialCells(xlVisible).Copy Worksheets("検索結果").Range("A1") '.AutoFilter End With End Sub
- ベストアンサー
- Visual Basic
お礼
ありがとうございました。 基本的な事がすっかり抜けてしまっていたようです。 助かりました。