Excel VBA質問箱 IV

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

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


5799 / 13646 ツリー ←次へ | 前へ→

【48808】条件に合った数式を取得したい。 カド 07/5/10(木) 7:54 質問[未読]
【48809】Re:条件に合った数式を取得したい。 ウッシ 07/5/10(木) 9:17 発言[未読]
【48810】Re:条件に合った数式を取得したい。 カド 07/5/10(木) 10:09 発言[未読]
【48811】Re:条件に合った数式を取得したい。 Jaka 07/5/10(木) 10:27 発言[未読]
【48812】Re:条件に合った数式を取得したい。 ウッシ 07/5/10(木) 10:43 発言[未読]

【48808】条件に合った数式を取得したい。
質問  カド  - 07/5/10(木) 7:54 -

引用なし
パスワード
   よろしくお願いいたします。
a列とd列に文字が入っています。
また、b列には式が入っています。

   a  b  c  d   e
1  f 式1   f
2  f 式2   a
3  f 式3   f
4  f 式4   b
5  f 式5   f

例えば式1は「=a10」です。

マクロを実行すると、
d列の最初のfの隣には、a列の最初のfの隣の式
d列の2番目のfの隣には、a列の2番目のfの隣の式
というように以下のような結果になってほしいのです。
カット&ペーストでb列の式が無くなっても良いし、
残っていても良いです。


   a  b  c  d   e
1  f      f  式1
2  f      a  
3  f      f  式2
4  f 式4   b  
5  f 式5   f  式3

処理後も式1は「=a10」です。

一方的に尋ねる形の質問で恐縮ですが、よろしくお願いいたします。

【48809】Re:条件に合った数式を取得したい。
発言  ウッシ  - 07/5/10(木) 9:17 -

引用なし
パスワード
   こんにちは

本当にその例でいいのですか?

A列は全て「f」・・・同じ文字ですか?

とすれば、
  >例えば式1は「=a10」
  の答えは「f」ですよ。

でなければ、
  D列の文字がばらばらなので、でD列をみてA列の文字と同じもの・・・
  という判断より、A列をみてD列の中で同じ文字を探すという処理にした方がいいかも。

【48810】Re:条件に合った数式を取得したい。
発言  カド  - 07/5/10(木) 10:09 -

引用なし
パスワード
   ▼ウッシ さん 回答ありがとうございます。

>本当にその例でいいのですか?
>A列は全て「f」・・・同じ文字ですか?

f、s、a、・・・などとしたかったのですが、
複雑になるので敢えて、全てfの例を挙げました。

>とすれば、
>  >例えば式1は「=a10」
>  の答えは「f」ですよ。

a10にはf以外のものが入っているとして、例としてあげました。
とにかく「=a10」という式が入ればいいです。

「=a10」が例としては確かに不適切でしたので、「=x10」と置き換えてもらっても、勿論構いません。

【48811】Re:条件に合った数式を取得したい。
発言  Jaka  - 07/5/10(木) 10:27 -

引用なし
パスワード
   1番の行に1行挿入して、d列をオートフィルタで「f」を抽出。
抽出したセルの右隣にA1から順繰り、関数を取り出して入れれば良いと思います。

関数の取り出しは、Formulaで取り出せます。

【48812】Re:条件に合った数式を取得したい。
発言  ウッシ  - 07/5/10(木) 10:43 -

引用なし
パスワード
   こんにちは

>f、s、a、・・・などとしたかったのですが、
>複雑になるので敢えて、全てfの例を挙げました。
全然意味が変わってくる重要な情報です。

>a10にはf以外のものが入っているとして、例としてあげました。
>とにかく「=a10」という式が入ればいいです。
これは、大した意味はないですけど、転記した先で循環参照にならなければOKです。

Sub test()
  Dim r As Range
  Dim f As Range
  Dim m As Range
  Dim a As Range
  For Each r In Range("D1", Range("D65536").End(xlUp))
    On Error Resume Next
    Set m = Range("B:B").SpecialCells(xlCellTypeFormulas)
    If Not m Is Nothing Then
      Set a = m.Offset(0, -1).Areas(m.Areas.Count)
      Set f = m.Offset(0, -1).Find( _
        r.Value, a.Cells(a.Cells.Count), xlValues, xlWhole)
      If Not f Is Nothing Then
        r.Offset(, 1).Formula = f.Offset(, 1).Formula
        f.Offset(, 1).ClearContents
      End If
    Else
      On Error GoTo 0
      Exit For
    End If
    Set m = Nothing
    Set f = Nothing
    Set a = Nothing
    On Error GoTo 0
  Next
  Set m = Nothing
  Set f = Nothing
  Set a = Nothing
End Sub

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