[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『エクセル関数についてご教示ください』(ほほ)
ご教示お願いいたします。
条件にあったシートの抽出方法についてですが、複雑ですので下記に詳細を記載いたします。
Sheet1のD6セルに売上の金額、D7に月の金額、D8に日額の金額の記載があります。
Sheet3に一覧表を作成しており、
C行:会社名 D行:売上の金額 E行:月の金額 F行:日額の金額 G行:総合金額
H行:適用
の一覧表があります。
このときに
条件1:D6の金額とSheet3D列の金額が一致するもので、
条件2:D7の金額とSheet3E列の金額が一致し、
条件3:D8の金額とSheet3F列が一致する
Sheet3のC〜Hの一行をSheet1のJ5を先頭行にして横一列に抽出したいのですが、
できますでしょうか。
関数でもマクロでもどちらでも構いません。
よろしくお願いいたします。
< 使用 Excel:Excel2007、使用 OS:unknown >
Dim c As Range, r As Range Sheets("Sheet1").Range("J5:O" & Rows.Count).Clear Set r = Sheets("Sheet1").Range("J5") For Each c In Sheets("Sheet3").Range("D:D").SpecialCells(2) If c.Value = Sheets("Sheet1").Range("D6").Value And c.Offset(, 1).Value = Sheets("Sheet1").Range("D7").Value And c.Offset(, 2).Value = Sheets("Sheet1").Range("D8").Value Then r.Resize(, 6).Value = c.Offset(, -1).Resize(, 6).Value Set r = r.Offset(1) End If Next c End Sub (mm) 2018/05/16(水) 17:16
思うような結果が出て、大変満足しております。
1点15行までを制限としたいのですが、できますでしょうか。
お忙しい中恐れ入ります。
(ほほ) 2018/05/16(水) 18:07
Set r = r.Offset(1)
if r.row>19 then exit sub
End If (mm) 2018/05/16(水) 18:13
Sheet1の背景を真っ白にしております。
上記のエクセルを稼働させると、Sheet3の背景の線がSheet1のセルの一番下までいってしまうので、それをどうにか15行までに抑えたいのですが対処法はありますか。
(ほほ) 2018/05/16(水) 18:17
こういうことかなぁ。。。。?
Sub test()
Const cRowCount As Long = 15 '既定の行数 Const cColCount As Long = 6 '既定の列数 Dim rngList As Range '一覧表 Dim rngResult As Range '結果出力先 Dim rngInput As Range '入力欄 Dim r As Range '各行 Dim ixRow As Long '出力先行番号
With Worksheets("Sheet3") Set rngList = Application.Range( _ .Range("C1"), .Cells(Rows.Count, "C").End(xlUp)).Resize(, cColCount) End With With Worksheets("Sheet1") Set rngInput = .Range("D7:D9") Set rngResult = .Range("J5").Resize(cRowCount, cColCount) End With
rngResult.ClearContents For Each r In rngList.Rows If rngInput(1).Value = r.Cells(2).Value Then If rngInput(2).Value = r.Cells(3).Value Then If rngInput(3).Value = r.Cells(4).Value Then ixRow = ixRow + 1 With rng.Rows(ixRow) If Intersect(rngResult, .Cells) Is Nothing Then Exit For .Value = r.Value End With End If End If End If Next End Sub (まっつわん) 2018/05/17(木) 08:56
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.