- ベストアンサー
エクセル金額抽出VBＡ
- エクセル金額抽出をするためのVBＡコードの助けを求めています。データ量が多く再計算時に問題が発生しており、解決策を探しています。
- シート1には単価表があり、シート2には種類、メーカー、年式、会員、状態のデータが入力されます。シート2のデータを基にシート1から金額と行を抽出したいです。
- データのサイズが大きく、Excelのバージョンも古いため、VBAの初心者である私には難しいですが、助けていただけると幸いです。
- みんなの回答 （2）
- 専門家の回答
質問者が選んだベストアンサー
こんにちは。 シート1は「単価表」というシート名にする。 先頭に列を追加し、種類、メ、年式をつなげた列を関数で作り、値貼りつけで値に置換えておく。 Ａ列 Ｂ列 Ｃ列 Ｄ列 ・・・・・・・・・・・ 検索列 種類 メ 年式 上 中 下 上 中 下 ＡＯ98 Ａ Ｏ 98 6 5 4 3 2 1 ＡＯ97 Ａ Ｏ 97 7 6 5 5 4 2 シート2のシート名タブを右クリックし、コードの表示で出てきたVBE画面の余白にコピペする。 状態セル = E列という認識なので、E列のセルに変化があった場合に動くようになっている。 シートの状態など、こちらでは判断付かないので上手く動かない場合も想定されます。 参考程度に。 Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim r As Range, fr As Range, fStr As String, fCol As Integer For Each r In Target If r.Column = 5 And r.Text <> "" Then fStr = r.Offset(0, -4).Text & _ r.Offset(0, -3).Text & _ r.Offset(0, -2).Text With Worksheets("単価表") Set fr = .Cells.Find(What:=fStr, _ After:=.Range("A1"), LookAt:=xlPart) If fr Is Nothing Then r.Offset(0, 1) = "": r.Offset(0, 2) = "" Else Select Case r.Offset(0, -1).Text Case "会員": fCol = 4 Case "一般": fCol = 7 Case Else: fCol = 0 End Select Select Case r.Text Case "上": Case "中": fCol = fCol + 1 Case "下": fCol = fCol + 2 Case Else: fCol = 0 End Select If fCol = 0 Then r.Offset(0, 1) = "": r.Offset(0, 2) = "" Else r.Offset(0, 1) = .Range(fr.Offset(0, fCol).Address) r.Offset(0, 2) = fr.Row End If End If End With End If Next r End Sub
その他の回答 (1)
- papayuka
- ベストアンサー率45% (1388/3066)
シート構成も解らないし、実際に見てる訳では無いですから思い通りに動作するとは限りません。 前回の補足回答を無視したかたちでの今回の質問ですから「シート2の600行のデータがたえず変更・追加される。」ものであると認識して書いてます。今回のは、E列（状態）のセル値に変化があった場合に動く仕組みです。 単価表 A2 B2 C2 D2 E2 F2 G2 H2 I2 J2 検索 種類 メ 年式 上 中 下 上 中 下 検索列は「= 種類 & メ & 年式」で算出し、値に置換え シート2（シート2のChangeイベントに前回サンプルをコピペ） A1 B1 C1 D1 E1 F1 G1 種類 メ 年式 会員 状態 金額 行
お礼
papayuka様 説明不足、知識不足で大変ご迷惑お掛けしました。 前回の質問の所に補足回答してくださった事に 気づいていませんでした。すいません ちゃんと確認しないとだめですね・・ （けして無視していたわけでありません） お怒りごもっともです 自分でもどうしたらいいのか、よくわからないので 説明不足でした。 papayuka様の作っていただいたＶＢＡを 理解できるようになって又質問させていただきます。 今回はご面倒お掛けしました そして有難うございました。
お礼
papayuka様有難うございます。 貴重な時間で作って頂いたことに感謝いたします。 朝からpapayuka様に教えられたとうりにやって みたのですが・・・ できませんでした。 シート1は 単価表 とシート名にする 単価表のＡ列にＢ列,Ｃ列,Ｄ列を＆でつなぐセルを作る シート2に作っていただいたＶＢＡを貼り付ける 保存をしてＯＫですか？ シート２の状態セル = E列です。