• ベストアンサー

VBAのボタンで数式を入れる方法

VBA初心者です。 未特定の行のデータシートの行数を調べて、その行数分特定の列に関数を入れるようなVBAを作成中です。 現在、下記のようなコーディングをしているのですが、セルに入れるものが関数になった時点で分からなくなりました。 Private Sub CommandButton1_Click() Dim rs As Integer rs = Range("D2").End(xlDown).Row Dim Ka As Integer Ka = ' →ここに数式を入れる方法が分かりません! Range(Cells(2, 5), Cells(rw, 5)) = Ka Worksheets("Sheet2").Activate MsgBox ("成功" & rs) End Sub こんな感じなんですが、宜しくお願いします。

質問者が選んだベストアンサー

  • ベストアンサー
  • nishi6
  • ベストアンサー率67% (869/1280)
回答No.2

こんな感じでしょうか。 Private Sub CommandButton1_Click() Dim rs As Integer rs = Range("D2").End(xlDown).Row Dim Ka As String ’文字列にしました Dim rCot As Integer '行カウンタ For rCot = 2 To rs ’算式を作るためにループさせています '<例>E列にはC列の100倍とE列を加算の式を入れる場合 'E2=C2*100+D2 右辺の2が行数で変わるので変数にする。後は文字列の結合 Ka = "=C" & rCot & "*100+D" & rCot 'Rangeの中にCellsを持ち込むと分かりにくいのでOffsetにしました Range("D2").Offset(rCot - 2, 1).Formula = Ka Next Worksheets("Sheet2").Activate MsgBox ("成功" & rs) End Sub

rurucom
質問者

お礼

nishi6さん!ありがとうございました。いつもありがとうございます。 ちょっとエラーが出てしまいましたが、今回は理屈が理解できました。とりあえず成功しました。

その他の回答 (1)

  • ryotag
  • ベストアンサー率25% (1/4)
回答No.1

質問の意味を取り違えていたら、ごめんなさい。 Range(Cells(2, 5), Cells(rw, 5)) に、関数を入れたいのなら、 Range(Cells(2, 5), Cells(rw, 5)).Formula="=$A$1+$A$2" 見たいな感じにすれば、関数そのものが入ります。 後は、特定の列全体に関数を入れるように、for等を使えば、出来そうな気がします。 どうでしょう?

rurucom
質問者

お礼

ryotagさん!ありがとうございました。完璧です! 最後のメッセージボックス "成功" を無事に見れるとことが出来ました。

関連するQ&A

  • 全くの初心者ですVBA

    どこが悪いかわかりません。 教えてください。 Sub テスト() Dim kekka As String Dim i As Integer tokuten = Worksheets("Sheet1").Cells(i, 1).Value For i = 1 To Worksheets("Sheet1").Range("A1").End(xlDown).Row.Count If tokuten >= 80 Then kekka = "合格" Else kekka = "不合格" kekka = Cells(i, 2) End If Next i End Sub シート1の A列に数値で得点が入っています。

  • Excel 2007 <VBAでグラフの操作>

    Excel 2007 <VBAでグラフの操作> 現在すでにあるグラフを修正しています。 下記マクロでは「各グラフに系列が2つあり、その1つ目を削除して残る1つのデータ範囲(X軸の値)を再設定する」という内容です。 下記マクロではFor構文冒頭のSet~の行で、 「実行時エラー '1004': 'Cells'メソッドは失敗しました:'_Global'オブジェクト」 とのエラーが出ます。 このエラーについて検索してみたのですが、これといったものが見つからなかったので、このマクロでおかしなところがあれば直接指摘していただけないでしょうか。 よろしくお願いします。 Private Sub Test_Arrange()   Dim MyRng As Range   Dim R As Integer   Dim n As Integer   Dim i As Integer   n = 10   R = Sheets("Sheet1").Range("A1").End(xlDown).Row   For i = 1 To n     Set MyRng = Sheets("Sheet1").Range(Cells(2, 2 * n + 3), Cells(R, 2 * n + 3))     Charts(i).SeriesCollection(1).Delete     Charts(i).SeriesCollection(1).XValues = MyRng   Next i End Sub

  • VBA超初心者です

    皆さんのお知恵を拝借させてください。 Sub Macro1() ' ' Macro1 Macro ' マクロ記録日 : 2007/12/1 ユーザー名 : 101 ' Dim pearend As Integer Dim code As Integer Dim codeend As Integer Dim sheet_name As String Dim dayend As Date Sheets("商品名").Select Range("A4").Select Selection.End(xlDown).Select pearend = Selection.Row() For l = 4 To pearend Step 2 For r = 2 To 3 Cells(l, r).Select code = Cells(l, r).Value Select Case code Case 1000 To 1999 sheet_name = "1000" Case 2000 To 2999 sheet_name = "2000" Case 3000 To 3999 ssheet_name = "3000" Case 4000 To 4999 sheet_name = "4000" Case 5000 To 5999 sheet_name = "5000" End Select Sheets(sheet_name).Select Range("B4").Select Selection.End(xlToRight).Select codeend = Selection.Column() Range("A5").Select Selection.End(xlDown).Select dayend = Selection.Row() For i = 2 To codeend If code = Cells(4, i).Value Then Range(Cells(dayend, i), Cells(5, i)).Select Selection.Copy Sheets("商品名").Select Range("K3").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End If Next Next Next End Sub というマクロをつくってみたのですが、何順目かあたりから For r = 2 To 3 のrがなぜか4になっています。正直知識がないのでさっぱりわかりません。どこに問題があるか詳しい方教えてください。

  • VBAでコピー&ペーストをループ化する方法

    お忙しいところ申し訳ありません、ご教授の程お願い致します。 ワークシート(1)とワークシート(2)の間で特定のセル列をコピー&ペーストしたくそれを列のデータが無くなるまで(空白まで)処理したいのですが、 単一セルの処理は Worksheets("ワークシート(1)").Range("BJ2") = Worksheets("ワークシート(2)").Range("E2") で値の貼り付けが実行され成功したのですがそれをループ化したい構文に当てはめると空白まで自動的に処理してくれるような動作をしません。 検索してしらべてみたのですが、 Sub test() Dim i As Integer i = 1 Do Until cells(i, 2) = "" cells(i, 2) = Worksheets("ワークシート(1)").cells(2, 62) = Worksheets("ワークシート(2)").cells(2, 5).End(xlDown) i = i + 1 Loop End Sub で、試してみましたが動作しなかったです。 お忙しいところ申し訳ありませんが、宜しく御願い申し上げます。

  • VBA 選択された離れたセルの値の取得について

    EXCELのVBAでどうしても前に進めず困っております。 目的としているコードは、離れたセル(複数)をあらかじめCtrlキーで選択状態にしておき、選択されたセルの値のみをVBAが別のセルに並べていくというものです。 以下が私の作ったコードなのですが、思ったとおりの動作をしてくれません。 VBA初心者なもので、おかしな記述がたくさんあると思うのですが、どなたかアドバイスお願いします。 Public Sub xx() Dim SelectArea As String Dim TargetCell As Range Dim a As Integer Dim Row As Integer Dim Column As Integer Dim CNT1 As Integer a = 0 Row = 0 Column = 0 For CNT1 = 1 To 10 Row = Row + 1 SelectArea = Selection.Address Set TargetCell = Range("B3").Cells(Row - 1, Column) If Intersect(Range(SelectArea), TargetCell) Is Nothing Then Else Range("A30").Cells(a, 0) = Range("B3").Cells(Row - 1, Column).Value a = a + 1 End If Next End Sub

  • VBAの簡略化について

    VBAで数値をカウントするマクロを作りました。  Dim Co1 As Integer Co1 = WorksheetFunction.CountIf(Range(Cells(○, ○), Cells(○, ○)), "<1") Dim Co2 As Integer Co2 = WorksheetFunction.CountIf(Range(Cells(○, ○), Cells(○, ○)), "<2") Dim Co3 As Integer Co3 = WorksheetFunction.CountIf(Range(Cells(○, ○), Cells(○, ○)), "<3") Dim Co4 As Integer Co4 = WorksheetFunction.CountIf(Range(Cells(○, ○), Cells(○, ○)), "<4") Dim Co5 As Integer Co5 = WorksheetFunction.CountIf(Range(Cells(○, ○), Cells(○, ○)), "<5") Dim Co6 As Integer Co6 = WorksheetFunction.CountIf(Range(Cells(○, ○), Cells(○, ○)), "<6") Dim Co7 As Integer Co7 = WorksheetFunction.CountIf(Range(Cells(○, ○), Cells(○, ○)), "<7") Dim Co8 As Integer Co8 = WorksheetFunction.CountIf(Range(Cells(○, ○), Cells(○, ○)), "<8") Dim Co9 As Integer Co9 = WorksheetFunction.CountIf(Range(Cells(○, ○), Cells(○, ○)), "<9") Dim Co10 As Integer Co10 = WorksheetFunction.CountIf(Range(Cells(○, ○), Cells(○, ○)), "<10") Dim Co11 As Integer Co11 = WorksheetFunction.CountIf(Range(Cells(○, ○), Cells(○, ○)), ">=10") Cells(2, 1) = Co1 Cells(3, 1) = Co2 - Co1 Cells(4, 1) = Co3 - Co2 Cells(5, 1) = Co4 - Co3 Cells(6, 1) = Co5 - Co4 Cells(7, 1) = Co6 - Co5 Cells(8, 1) = Co7 - Co6 Cells(9, 1) = Co8 - Co7 Cells(10, 1) = Co9 - Co8 Cells(11, 1) = Co10 - Co9 Cells(12, 1) = Co11 Cells(2, 1) = "0~0.999" Cells(3, 1) = "1~1.999" Cells(4, 1) = "2~2.999" Cells(5, 1) = "3~3.999" Cells(6, 1) = "4~4.999" Cells(7, 1) = "5~5.999" Cells(8, 1) = "6~6.999" Cells(9, 1) = "7~7.999" Cells(10, 1) = "8~8.999" Cells(11, 1) = "9~9.999" Cells(12, 1) = "10~" これを短くする方法を教えてください。

  • vba 四捨五入 について教えてください。

    VBA初心者です。お世話になりますがよろしくお願いします。 vbaでRound関数を使って四捨五入したいと考えております。 以下のコードで実行するとエラー(プロシージャの呼び出し,または引数が不正です。)が出ます。 何がなんだかわからずに困っております。 どうかご教授よろしくお願いします。 Sub 計算() Worksheets("abc").Activate Dim LastRow As Long Dim i As Integer LastRow = Worksheets("abc").Range("K65536").End(xlUp).Row For i = 6 To LastRow If Cells(i, 11) = 0 Then Cells(i, 12) = "" Else Cells(i, 12) = Round(Cells(i, 9) / Cells(i, 11),-2) End If Next End Sub

  •  VBA 表作成で内容を最下行で入力した場合 自動で次の行の作成を行いたい。

    VBAで質問です。  Excel2003 最下行を検索し、そこの内容部分を入力された場合、1行あたらしく 式、罫線をコピーしたいのですがずっとループを起こしてしまいます。 直し方を教えていただきたいです。 ソース Private Sub Worksheet_Change(ByVal Target As Range) '------------------------------------ '変数の宣言 '------------------------------------ Dim naiyou As Object Dim bikou As Object Dim xline As Integer Dim yline As Integer Dim count As Integer Dim startrow As Integer Dim maxcolumn As Integer '------------------------------------ '内容=D4の列検索 '------------------------------------ Set naiyou = ActiveSheet.Cells.Find("内容") xline = naiyou.Column '------------------------------------ '表示している最終行の検索 '------------------------------------ startrow = 4 count = Cells(startrow, xline).End(xlDown).Row '------------------------------------ '備考の=I4列検索 '------------------------------------ Set bikou = ActiveSheet.Cells.Find("備考") yline = bikou.Column '------------------------------------ 'コピペ処理 '------------------------------------ If ActiveSheet.Cells(count, 4) <> "" Then Range(Cells(count + 1, 1), Cells(count + 1, yline)).Select Selection.Copy Range(Cells(count + 2, 1), Cells(count + 2, yline)).Select ActiveSheet.Paste Application.CutCopyMode = False Exit Sub Else: End If End Sub

  • エクセル2019 VBAについて

    エクセル2019でVBAを使いコピーペーストの勉強中です、次の箇所(Dim i As integr)で、ユーザー定義型は定義されていませんと指摘されて止まってしまします、Sheet("データ")には3行のデータは入っています、VBA初心者のため、この後が、なかなか前に進めません、どうかよろしくおねがいします。 ********************************** Sub 練習() Dim s1 As Worksheet: Set s1 = Worksheets("請求書") Dim s2 As Worksheet: Set s2 = Worksheets("データ") Dim r1 As Integer: r1 = 18 Dim r2 As Integer: r2 = 2 { Dim i As integr } For i = 0 To 2 s1.Range(s1.Cells(r1 + i, 1), s1.Cells(r1 + i, 3)).Value = s2.Range(s2.Cells(r2 + i, 2), s2.Cells(r2 + i, 4)).Value s1.Cells(r1 + i, 4).Value = s1.sells(r1 + i, 2).Value * s1.Cells(r1 + i, 3).Value Next End Sub ***************************************

  • エクセルVBAで。

    お世話になります。 VBA初心者です。 (初心者でもないのですが、しばらく遠ざかっていました。) エクセルVBAの記述内容をコピーし、 エクセルの通常のシートへ貼り付けした際、 記述上「’」で始まる文字は緑色が付いていますが、 通常のシートへ貼り付けした際、黒字になってしまいます。 そこで、下記の様なVBAを記述し、貼り付け後に、 「’」から始まる文字を緑色に着色しようと試みましたが (やはり)うまくいきませんでした。 エクセル関数なんかも織り交ぜたおかしな記述だと思いますが 何となくやりたい事が伝わって頂けるかと思うのですが、 どう修正したら出来ますでしょうか。 ご教授下さいます様、宜しくお願いいたします。   記 Sub 色() Dim y As Integer Dim x As Integer Dim a As Integer mysheet = ActiveSheet.Name For y = 1 To 10 x = Sheets(mysheet).Cells(Rows.Count, y).End(xlUp).Row a = 0 Do Until a > x a = a + 1 If Right(Cells(y, a), 1) = "'" Then Cells(y, a).Select Selection.Font.ColorIndex = 10 End If Loop Next End Sub

専門家に質問してみよう