[[20110604235002]]　『Vlookしたあとのマクロ』（古河）　ページの最後に飛ぶ

『Vlookしたあとのマクロ』（古河）

列もしくは行毎もしくはセルを全体を選び Vlookで抽出した数値を一括でコピーして数値のみ貼り付けするマクロがほしいです

 Vlookという関数はよくしらないけど、選択したセル領域のあちこちに=VLOOKUP(・・・・)という式が入っている。
 で、それらのセルの内容を値に変換するということ？
 そういうことならマクロでできるけど。

 ぶらっと立ち寄り

 とりあえず↑の解釈で。
 結果が#N/A等、エラーになっているセルは値置換え対象外にしている。
 XL2003までなら、VLOOKUPが見つかった領域の数（連続したセルなら１と数えて）が8192以上だと、とんでもないことになるので要注意。

 Sub Sample()
    Dim c As Range, f As Range
    Dim r As Range

    If TypeName(Selection) <> "Range" Then
        MsgBox "セル領域が選択されていません"
    Else

        Set c = Selection.Find(What:="=VLOOKUP(", LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, MatchByte:=False, SearchFormat:=False)
        If c Is Nothing Then
            MsgBox "対象の関数がありません"
        Else
            Set f = c
            Do
                If Not IsError(c.Value) Then
                    If r Is Nothing Then
                        Set r = c
                    Else
                        Set r = Union(r, c)
                    End If
                 End If
                 Set c = Selection.FindNext(c)
            Loop While c.Address <> f.Address
        End If

        If Not r Is Nothing Then r.Value = r.Value

        Set r = Nothing
        Set f = Nothing
        Set c = Nothing

    End If

 End Sub

 ぶらっと立ち寄り

ぶらっとさんありがとうございます

N/♯でもなんでもかまいませんVlookの計算式が入っているセルはコピー形式値だけ張り付け状態にしたいです
(古河)

 それでは

    If Not IsError(c.Value) Then
        If r Is Nothing Then
            Set r = c
        Else
            Set r = Union(r, c)
        End If
    End If
    Set c = Selection.FindNext(c)

 これを以下のように

    If r Is Nothing Then
        Set r = c
    Else
        Set r = Union(r, c)
    End If
    Set c = Selection.FindNext(c)

 ぶらっと立ち寄り

ぶらっとさん本当に助かりました(ノ△Ｔ) 仕事がはかどります

また御指導頂きたいのですが N/♯等のエラーセルを数値の0入れたいのですが
(古河)

上記の件　可能でしょうか（古河）

 VLOOKUPによるエラー値以外も、まとめて0にする手抜き版。

 Sub Sample2()
    Dim c As Range, f As Range
    Dim r As Range, er As Range

    If TypeName(Selection) <> "Range" Then
        MsgBox "セル領域が選択されていません"
    Else

        Set c = Selection.Find(What:="=VLOOKUP(", LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, MatchByte:=False, SearchFormat:=False)
        If c Is Nothing Then
            MsgBox "対象の関数がありません"
        Else
            Set f = c
            Do
                If Not IsError(c.Value) Then
                    If r Is Nothing Then
                        Set r = c
                    Else
                        Set r = Union(r, c)
                    End If
                 End If
                 Set c = Selection.FindNext(c)
            Loop While c.Address <> f.Address
        End If

        If Not r Is Nothing Then r.Value = r.Value
        Set er = Cells.SpecialCells(xlCellTypeConstants, 16)
        If Not er Is Nothing Then er.Value = 0
        Set er = Nothing
        Set r = Nothing
        Set f = Nothing
        Set c = Nothing

    End If

 End Sub

 ぶらっと立ち寄り

Set er = Cells.SpecialCells(xlCellTypeConstants, 16)がエラーでます　（古河）

 ごめん、ごめん。
 エラー値がシート上にない場合、実行時エラーになる手当を忘れていた。

On Error Resume Next
Set er = Cells.SpecialCells(xlCellTypeConstants, 16)
On Error GoTo 0

 このように前後にOn Errorを。

 ぶらっと立ち寄り

あらごめんなさい。まだうまくいかないみたいです。すみません。（古河）

 アップしたイメージが改行なしになっていた。

 On Error Resume Next  
 Set er = Cells.SpecialCells(xlCellTypeConstants, 16) 
 On Error GoTo 0

 これでうまくいくはず。
 なお、今後のために、「うまくいかない」ばあいは、エラーメッセージも記載すること。

 ぶらっと立ち寄り

全体的になりません(;_;)

まずエラーではないのもうまく張り付けられてません。

またエラーセルが0になりません

わがままいってすみませんp(´⌒｀q)

(古河)

 >まずエラーではないのもうまく張り付けられてません。 
 >またエラーセルが0になりません

 ???????

 いったんは、
 「本当に助かりました(ノ△Ｔ) 仕事がはかどります 」
 ということで、値への置き換えは動いたね。で、それに、#N/A なんかを0にするところを加えただけ。
 なのに、もともとの値の置き換えもできなくなったということ？
 「対象の関数がありません」というメッセージもでずに？

 ぶらっと立ち寄り

 正常にVLOOKUPで抽出されているセルは↑で書いたように値に置き換わっていると思うけど
 エラー値の0変換については、１ヶ所手を入れるところが抜けていた。
 以下、再掲。

 Sub Sample3()
    Dim c As Range, f As Range
    Dim r As Range, er As Range

    If TypeName(Selection) <> "Range" Then
        MsgBox "セル領域が選択されていません"
    Else

        Set c = Selection.Find(What:="=VLOOKUP(", LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, MatchByte:=False, SearchFormat:=False)
        If c Is Nothing Then
            MsgBox "対象の関数がありません"
        Else
            Set f = c
            Do
                If r Is Nothing Then
                    Set r = c
                Else
                    Set r = Union(r, c)
                End If
                Set c = Selection.FindNext(c)
            Loop While c.Address <> f.Address
        End If

        If Not r Is Nothing Then r.Value = r.Value
        On Error Resume Next
        Set er = Cells.SpecialCells(xlCellTypeConstants, 16)
        On Error GoTo 0
        If Not er Is Nothing Then er.Value = 0
        Set er = Nothing
        Set r = Nothing
        Set f = Nothing
        Set c = Nothing

    End If

 End Sub

 ぶらっと立ち寄り

 >正常にVLOOKUPで抽出されているセルは↑で書いたように値に置き換わっていると思うけど
 本当は、質問者が不具合例をきちんと記述するべきなんですけどねえ！！

 新規ブックの標準モジュールにて、

 Sub 誤動作サンプル()
    With ActiveSheet
       With .Range("d1:e10")
          .Formula = Array("=row()", "=char(row()+64)")
          .Value = .Value
       End With
       With Range("a1:a10")
          .Formula = "=row()"
          .Value = .Value
       End With
       With Range("b1:b4,b6:b10")
          .Formula = "=vlookup(a1,$d$1:$e$10,2,false)"
          .Interior.ColorIndex = 4
       End With
       .Range("b5").Value = "******"
       .Range("a1:b10").Select
    End With
 End Sub

 上記の誤動作サンプル実行してみてください。

 Vlookup関数のあるセルは、色が付けられています。

 A1:B10が選択された状態で、Sample3を実行すれば、
 確かにb6:b10は、正しく値に置き換わりません。

 ichinose@Excel2002で確認

 ichinoseさんの誤動作サンプルをステップ実行して、とんでもないチョンボをしていたことにいまさらながら気が付きました。
 ちょっと、根本的にコードを書き直さなきゃ　ですね。
 見つかった都度、値に変換すべきでしたね。そうしておけば、エラー値変換もその場でできたわけで。

 今晩は、まだ時間がとれないので、明日にでも。

 ぶらっと立ち寄り@意気消沈

 と思ったけど、寝つきが悪くなる予感がするので、書き直して再掲。

 Sub Sample4()
    Dim c As Range

    If TypeName(Selection) <> "Range" Then
        MsgBox "セル領域が選択されていません"
    Else

        Set c = Selection.Find(What:="=VLOOKUP(", LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, MatchByte:=False, SearchFormat:=False)
        If c Is Nothing Then
            MsgBox "対象の関数がありません"
        Else
            Do
                c.Value = c.Value
                If IsError(c.Value) Then c.Value = 0
                Set c = Selection.FindNext(c)
            Loop While Not c Is Nothing
        End If
     End If

 End Sub ぶらっと立ち寄り@○度目の正直

最高に助かりました(≧∇≦) 仕事が楽になりますありがとうございました(古河)

ちなみに教えてほしいですがエラーセルにいま0が入りますが空白にできますか？ (古河)

 コードはちゃんと見て居られるのでしょうか？

 何が書いてあるのか分からなくても、値が「0」に成るのだから
 コード内で値を「0」にしている所が有るはず。

 該当個所を見つける所までは出来ているけど、空白にするために
 どの様に書けば良いのか分からない　って事ですか？

 まずは駄目もとで色々やってみる。
 それから
 「☆☆部分を　○○とか、△△とか　に変更してやってみたけど
 　◇◇に成って上手く行かない。どうすればよいか。」
 の様に書いておかれるのが良いと思います。

 (HANA)

コメント返信：

[ 一覧(最新更新順) ]

[[20110604235002]] 『Vlookしたあとのマクロ』（古河） ページの最後に飛ぶ

[[20110604235002]]　『Vlookしたあとのマクロ』（古河）　ページの最後に飛ぶ