エクセル VBA マクロについて

質問

初めまして。
以下のようなマクロを組みたいんですが可能でしょうか？
　A　　　　　B　　　　　C　　　　D　　　　E　　　　F
東京　　　足立区　みかん　　10　　　5　　　50
　　　　　　葛飾区　みかん　　20　　　3　　　60
　　　　　　　港区　　りんご　　30　　　1　　　30
小計　　　　　　　　　　　　　　　　　　　　　　　140
( 空白行　　　）
愛知　　名古屋市　みかん　　10　　　5　　　50
　　　　　東海市　　　　もも　　　10　　　5　　　50
小計　　　　　　　　　　　　　　　　　　　　　　　100

上記のようなデーターシートがあります。
Ｄには数字が入ってるんですが、
ここに係数をかけたいんです。

たとえば、=10*1.07 とか

(1)元の値に係数かける式をセルに入れるマクロはあるんでしょうか？
(2)この係数を別シートのセルで入力したいんですが
セルを参照できますか？
(3)みかん、もも、りんごの列を検索して、
　それに対応した係数かけるマクロはあるんでしょうか？

処理速度は、とくにはこだわりません。
ご指導おねがいいたします。

回答No.4

Wendy02

こんにちは。

よほど大量でないと、VBAのメリットが出てきません。VLOOKUPは、大量のデータには弱いのですが、少量、数式がベストだと思います。

#2のimogasiさんのおっしゃるとおりです。
#こういうVBAはSheet1のB1の２０やSheet2の１．８が変わっても結果を変えてくれない。

したがって、マクロを良く見ていただければ分かると思いますが、マクロに反映させるということは、係数が変わったときの修正のことまで考えなくてはなりません。そうすると、二つのマクロが必要になるのではないか、と思いました。

他の方のマクロとは違い、#1さんの書いた方法を、なるべく忠実にマクロに反映しているつもりですから、数式の中に、係数を入れています。

>(1)元の値に係数かける式をセルに入れるマクロはあるんでしょうか？
>(2)この係数を別シートのセルで入力したいんですが

D1 は、数式に変わります。
10 --> = 10 * 1.1
''---------------------------------------------
Sub SampleMacro1()
''係数によって数式にするマクロ　　
　　''***************************************
　　'ユーザー設定
　　Const KEISU As String = "Sheet2!A2" '係数の先頭行
　　Const DAINYU As String = "Sheet1!D1" '数式を入れる列の先頭
　　''***************************************
　　Dim sh1 As Worksheet
　　Dim sh2 As Worksheet
　　Dim rng1 As Range
　　Dim rng2 As Range
　　Dim ret As Variant
　　Dim c As Variant
　　Dim i As Long
　　Dim msg As String

　　On Error GoTo ErrHandler
　　Set sh2 = Worksheets(Split(KEISU, "!")(0))
　　Set rng2 = sh2.Range(Split(KEISU, "!")(1))
　　Set rng2 = rng2.CurrentRegion
　　If rng2.Columns.Count > 2 Then
　　　　MsgBox "係数データが２列以上あります。", vbInformation
　　　　Exit Sub
　　End If
　　Set sh1 = Worksheets(Split(DAINYU, "!")(0))
　　Set rng1 = Range(Split(DAINYU, "!")(1))
　　Application.ScreenUpdating = False
　　With sh1

　　　 ''隣が文字列 and 検索セルが数字 and 数式でないこと
　　　　For Each c In .Range(rng1, .Cells(65536, rng1.Column).End(xlUp))
　　　　　　If VarType(c.Offset(, -1).Value) = vbString And _
　　　　　　　　VarType(c.Value) = vbDouble And _
　　　　　　　　c.HasFormula = False Then
　　　　　　　　ret = Application.VLookup(Trim(c.Offset(, -1).Value), rng2, 2, 0)
　　　　　　　　If Not IsError(ret) Then
　　　　　　　　　　c.FormulaLocal = "=" & c & "*" & ret
　　　　　　　　　　i = i + 1
　　　　　　　　End If
　　　　　　End If
　　　　Next c
　　End With
　　Application.ScreenUpdating = True
　　Set sh1 = Nothing: Set sh2 = Nothing
　　Set rng1 = Nothing: Set rng2 = Nothing
　　If i > 0 Then
　　　msg = i & "個、正しく終了しました。"
　　Else
　　　msg = "変換するセルが見当たりませんでした。"
　　End If
　　　MsgBox msg, vbInformation
　　Exit Sub
ErrHandler:
　'エラーの発生

　If Err.Number = 9 Then
　　 msg = "Error!　ユーザー設定の項目は、正しく入力されていません。例：Sheet!A2"
　 Else
　　 msg = "Error! " & Err.Number & "：" & Err.Description
　 End If
　 MsgBox msg
End Sub
''---------------------------------------------
Sub CombackNum()
''掛けた数式を元に戻すマクロ
'マウスで範囲を選択
　　Dim rng As Range
　　Dim c As Variant
　　Dim i As Long
　　Dim buf As Variant
　　If TypeName(Selection) = "Range" Then
　　　　Set rng = Selection　'*
'*範囲が決まっていたら、最初から、Selection をRange("D1:D1000") のようにしても可能です。
　　　　If rng.Count = 1 Then MsgBox "範囲を選択していないと思われます。", vbInformation: Exit Sub
　　　　For Each c In rng
　　　　　　If c.HasFormula Then
　　　　　　　　buf = c.Formula
　　　　　　　　buf = Replace(c.Formula, "=", "")
　　　　　　　　If InStr(buf, "*") > 0 Then
　　　　　　　　　　buf = Mid(buf, 1, InStr(buf, "*") - 1)
　　　　　　　　　　If IsNumeric(buf) Then
　　　　　　　　　　　　c.Value = buf
　　　　　　　　　　Else
　　　　　　　　　　　　i = i + 1
　　　　　　　　　　End If
　　　　　　　　End If
　　　　　　End If
　　　　Next c
　　　　MsgBox "終了しました。変換し残し数：" & i, vbInformation
　　Else
　　　　MsgBox "場所が違うかもしれません。", vbInformation
　　End If
End Sub
''---------------------------------------------

回答No.3

imogasi

関数でも出来ることを無理してVBA（の勉強かも知れないが）でやろうとしているようだ。エクセルの関数を使いこなして、初めてVBAで無いと難しい問題を、VBAでする。
その切り（使い分け）分けをすることも、VBAの利用・習熟にも大切なことのはず。なんでもVBAと言うのも、まだVBAが良くわかって無いということ。
ーーー
（１）聞くまでも無いレベルの質問
例
Sub test01()
Cells(3, "A") = Cells(1, "C") * 1.07
End Sub
（２）出来ますかというよりも、どういうコードになりますかと聞くべき事項。もしこれが出来なければ、VBAの利用が、狭まる。だからできるはずだ、ぐらい考えること。
Sub test02()
Worksheets("Sheet1").Cells(2, "A") = Worksheets("Sheet1").Cells(1, "C") * Worksheets("Sheet2").Cells(1, "C")
End Sub
（３）（３）の質問を見ると、（１）（２）にまじめに私が回答したことが、適当で無いことがわかった。回答者を惑わさないこと。
実例を質問に書いて質問しないからだ
例　こういう例だ
Sheet2
F1:G3
みかん　１．３
もも　　２．４
りんご　１．８
ーーー
Sheet1で　A1:B1に
りんご　　２０
とあれば
Sub test03()
Worksheets("Sheet1").Cells(1, "C") = Worksheets("Sheet1").Cells(1, "B") * Application.WorksheetFunction.VLookup( _
Worksheets("Sheet1").Cells(1, "A"), Worksheets("Sheet2").Range("F1:G3"), 2, False)
End Sub
結果
りんご 20 36 倍数1.8
こういうVBAはSheet1のB1の２０やSheet2の１．８が変わっても結果を変えてくれない。
だから連動してくれる、普通の関数の方が良いのだ。
生半可にVBAを使わないほうが良い。
また上記ではWorksheets("Sheet1").の部分が長ったらしいが、別の方法も有るが、質問者にはややこしきなるので略。
VBAで他シート参照を使うのは質問者には早すぎると思う。

回答No.2

merlionXX

Sheet1に、商品名がC列、数値がD列
Sheet2に、商品名がA列、それに対応した係数がB列
という配置の場合、以下で出来ると思います。
記載がなかったので係数を乗じた値は四捨五入等の処理はしていません。

Sub test01()
Dim x As Long, i As Long
Dim y As Double
With Sheets("Sheet1")
x = .Cells(Rows.Count, "D").End(xlUp).Row '最終行取得
For i = 1 To x
If .Cells(i, "D") <> "" Then 'D列が空白でなければ
If IsNumeric(.Cells(i, "D")) Then 'D列が数字であれば
y = Sheets("Sheet2").Columns("A:A").Find(What:=.Cells(i, "C"), LookAt:=xlWhole).Offset(, 1).Value '係数検索
.Cells(i, "D").Value = .Cells(i, "D").Value * y '係数を乗じる
End If
End If
Next i
End With
End Sub

回答No.1

12ken3

こんにちは
マクロではなく簡単な関数で、出来そうです
マクロでの回答は他の人にお任せします

別シート（sheet2）の
　　　A　　　　B
１　　　　　　係数
２　みかん　　1.1
３　りんご　　1.2
４　もも　　　1.3
とします

データシートのＦ列（Ｆ２）に
=(VLOOKUP(C２,Sheet2!$A$2:$B$4,2,FALSE))*D２*E２
を入力し、必要セルにコピーすれば出来ると思います