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

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

たとえば、=10*1.07 とか

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

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

このQ&Aに関連する最新のQ&A

A 回答 (4件)

こんにちは。



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

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

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

他の方のマクロとは違い、#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 "係数データが2列以上あります。", 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
''---------------------------------------------
    • good
    • 0

関数でも出来ることを無理してVBA(の勉強かも知れないが)でやろうとしているようだ。

エクセルの関数を使いこなして、初めてVBAで無いと難しい問題を、VBAでする。
その切り(使い分け)分けをすることも、VBAの利用・習熟にも大切なことのはず。なんでもVBAと言うのも、まだVBAが良くわかって無いということ。
ーーー
(1)聞くまでも無いレベルの質問

Sub test01()
Cells(3, "A") = Cells(1, "C") * 1.07
End Sub
(2)出来ますかというよりも、どういうコードになりますかと聞くべき事項。もしこれが出来なければ、VBAの利用が、狭まる。だからできるはずだ、ぐらい考えること。
Sub test02()
Worksheets("Sheet1").Cells(2, "A") = Worksheets("Sheet1").Cells(1, "C") * Worksheets("Sheet2").Cells(1, "C")
End Sub
(3)(3)の質問を見ると、(1)(2)にまじめに私が回答したことが、適当で無いことがわかった。回答者を惑わさないこと。
実例を質問に書いて質問しないからだ
例 こういう例だ
Sheet2
F1:G3
みかん 1.3
もも  2.4
りんご 1.8
ーーー
Sheet1で A1:B1に
りんご  20
とあれば
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
結果
りんご2036倍数1.8
こういうVBAはSheet1のB1の20やSheet2の1.8が変わっても結果を変えてくれない。
だから連動してくれる、普通の関数の方が良いのだ。
生半可にVBAを使わないほうが良い。
また上記ではWorksheets("Sheet1").の部分が長ったらしいが、別の方法も有るが、質問者にはややこしきなるので略。
VBAで他シート参照を使うのは質問者には早すぎると思う。
    • good
    • 0

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
    • good
    • 0

こんにちは


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

別シート(sheet2)の
   A    B
1      係数
2 みかん  1.1
3 りんご  1.2
4 もも   1.3
とします

データシートのF列(F2)に
=(VLOOKUP(C2,Sheet2!$A$2:$B$4,2,FALSE))*D2*E2
を入力し、必要セルにコピーすれば出来ると思います
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!


人気Q&Aランキング

おすすめ情報