エクセルVBAでつまずいています
教えてください。以前別のブックから、抽出条件を指定して、
項目を追加して、ある条件を検査して、それによって追加した項目の列
に対応する値を書き込むというコードを教えていただきました。
質問は、今現在、
With .Range("AH2").Resize(r - 1, 1)
.FormulaR1C1 = _
"=IF(RC[-25]=""AAA"",""aaa""," & _
"IF(RC[-25]=""BBB"",""bbb""," & _
"IF(RC[-25]=""CCC"",""ccc""," & _
"IF(RC[-25]=""DDD"",""ddd"",""xxx"")
の部分で、関数を設定していますが、AIの列にも同じように関数
(VLOOKUP)を設定したいのですが、Resize(r - 1, 1)の意味するところが
しっかり理解していないためできません。
A1形式ですが、例えば、
参照先がD2、A2:J100として
=VLOOKUP(D2,A2:J100,5,FASE)
=VLOOKUP(D2,A2:J100,6,FASE)
=VLOOKUP(D2,A2:J100,7,FASE)
という条件を追加したいのですが、わかりませんでした。
どのようにしたらいいでしょうか。よろしくお願いします。
Sub test()
Dim wb As Workbook
Dim ws As Worksheet
Dim ms As Worksheet
Dim nb As Workbook
Dim r As Long
Set ms = ThisWorkbook.Worksheets("条件入力")
Set wb = Workbooks.Open(ms.Parent.Path & "\" & ms.Range("D3").Value)
Set ws = wb.Worksheets("元データ")
Set nb = Workbooks.Add
With ws
.Range("Q1").AutoFilter _
Field:=17, _
Criteria1:=">=" & ms.Range("D5").Text, _
Operator:=xlAnd, _
Criteria2:="<=" & ms.Range("F5").Text
With .AutoFilter.Range
r = .Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count
If r = 1 Then
MsgBox "抽出対象データ無し。"
wb.Close False
nb.Close False
Set wb = Nothing: Set ws = Nothing
Set ms = Nothing: Set nb = Nothing
Exit Sub
End If
.Copy
End With
End With
With nb.Worksheets(1)
.Paste
With .Range("A1:AG1")
.Interior.ColorIndex = 6
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
.Range("AH1").Value = "追加項目A"
.Range("AI1").Value = "追加項目B"
.Range("AJ1").Value = "追加項目C"
.Range("AK1").Value = "追加項目D"
With .Range("AH2").Resize(r - 1, 1)
.FormulaR1C1 = _
"=IF(RC[-25]=""AAA"",""aaa""," & _
"IF(RC[-25]=""BBB"",""bbb""," & _
"IF(RC[-25]=""CCC"",""ccc""," & _
"IF(RC[-25]=""DDD"",""ddd"",""xxx"")
End With
End With
nb.SaveAs _
Filename:=ms.Parent.Path & "\" & _
Replace(wb.Name, ".xls", "") & "更新データ.xls"
wb.Close False
nb.Close
Set wb = Nothing: Set ws = Nothing
Set ms = Nothing: Set nb = Nothing
End With
End Sub
補足
うまくいきました。 ありがとうございました。 色々調べました。 For i = 1 To 5 VBA.AppActivate Excel.Application.Caption waitTime = Now + TimeValue("0:00:1") Application.Wait waitTime VBA.AppActivate ("Microsoft Excel") waitTime = Now + TimeValue("0:00:1") Application.Wait waitTime VBA.AppActivate ("Microsoft PowerPoint") waitTime = Now + TimeValue("0:00:1") Application.Wait waitTime VBA.AppActivate ("Windows Internet Explorer") waitTime = Now + TimeValue("0:00:1") Application.Wait waitTime Next このprocedureで、ウィンドウの選択が移り変わります。 しかし、Windows exploreは、うまくいきません。 確かに、インターネットで調べると、Window sexploreはうまくいかないと 書かれていますが、本当にできないのでしょうか？ よろしくお願いします。