Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


30460 / 76738 ←次へ | 前へ→

【51545】Re:数式を挿入
回答  りん E-MAIL  - 07/9/24(月) 19:39 -

引用なし
パスワード
   isida さん、こんばんわ。

>下記の数式を行毎に挿入したいのですがよろしくお願いします。
>L9==IF(ISBLANK(H9),"",IF(I9="X",(H9*J9/1000000),IF(I9="L",H9*J9/1000000,IF(I9="P",(H9*H9)/1000000*0.785))))
↑を既に分岐した状態で書きこみたいということでしょうか。

>
>1.H9に数値が(1以上)入力されたら各列に数式書込
ということなので、Changeイベントで対応しました。

該当のシートのChangeイベントに以下を記述してください。

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim r1 As Range, r2 As Range, s1 As String
  '範囲内を判定
  Set r1 = Application.Intersect(Target, Range("H9:H95"))
  '範囲内をループ
  If Not r1 Is Nothing Then
   Application.EnableEvents = False 'イベント回避
   For Each r2 In r1
     With r2
      If IsNumeric(.Value) Then
        If .Value >= 1 Then
         'I列で分岐(半角大文字で判定)
         Select Case StrConv(.Offset(, 1).Value, vbNarrow + vbUpperCase)
           Case "X","L": s1 = "=RC[-4]*RC[-2]/1000000"
           Case "P": s1 = "=RC[-4]*RC[-4]/1000000*0.785"
           Case Else: s1 = ""
         End Select
         .Offset(, 4).FormulaR1C1 = s1 'Lは分岐結果
         .Offset(, 6).FormulaR1C1 = "=IF(RC[-6]>0,RC[-2]*RC[-1],"""")"
         .Offset(, 7).FormulaR1C1 = "=IF(RC[-4]>0,RC[-4]/RC[-1]/3600,"""")"
         .Offset(, 14).FormulaR1C1 = "=IF(RC[-6]>0,AVERAGE(RC[-6]:RC[-1]),"""")"
         .Offset(, 15).FormulaR1C1 = "=IF(ISBLANK(RC[-7]),"""",RC[-9]*RC[-1]*3600)"
        End If
      End If
     End With
   Next
   Application.EnableEvents = True 'イベント再開
  End If
  '終了
  Set r1 = Nothing
End Sub
こんな感じです。

H9:H95の間に1以上の数値が入ると数式が入ります。
既に入っている場合は上書きされます(ほぼ同じ式が入るわけですが)。
0 hits

【51544】数式を挿入 isida 07/9/24(月) 12:55 質問
【51545】Re:数式を挿入 りん 07/9/24(月) 19:39 回答
【51548】Re:数式を挿入 isida 07/9/24(月) 22:46 質問
【51549】Re:数式を挿入 isida 07/9/25(火) 0:01 質問
【51550】Re:数式を挿入 りん 07/9/25(火) 0:11 回答
【51551】Re:数式を挿入 isida 07/9/25(火) 0:32 お礼
【51552】Re:数式を挿入 りん 07/9/25(火) 0:50 発言
【51553】Re:数式を挿入 isida 07/9/25(火) 1:04 お礼

30460 / 76738 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free