Excel VBA質問箱 IV

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

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


25888 / 76736 ←次へ | 前へ→

【56185】文字の検索〜他シートへの書き出しについて。
質問  瞬希  - 08/6/8(日) 14:12 -

引用なし
パスワード
   皆様始めまして、1ヶ月ほど前からvbaに取り組んでいます。
vbaの辞典やネットでもかなり調べてみたのですが全く作業が進展しなくなってしまいました、皆様に知恵をお借りしたいと思い投稿させて頂きましたよろしくお願いいたします。

ブックのシート1のC列に文字が入力されています、H列にも文字が入力されています。
(sheet1)
    C列    H列
    1    A
    2    B
    3    C
    4    D
    5    E
    6    F
    1    A
    2    B
    3    C
    4    D
    5    E
    6    F
このシート1のC列の文字を上から連続で取得し、順番に検索させてシート2に
    C列    H列
    1    A
    1    A
    2    B
    2    B
    3    C
    3    C
    4    D
    4    D
    5    E
    5    E
    6    F
    6    F
となるように書き出しを行いたいと思い次のマクロを書いてみたのですが、

Private Sub CommandButton7_Click()
Dim mykekka As Range
Dim myfirst As String
Dim srcname As String
Dim i As Long
Dim lRow1 As Long
Dim lRow2 As Long

lRow1 = Worksheets("sheet1").Range("c" & Rows.Count).End(xlUp).Row


For i = 2 To lRow1 Step 1
srcname = Worksheets("sheet1").Cells(i, 3)
    Set mykekka = Worksheets("sheet1").Range("c:c") _
      .Find(what:=srcname, _
            lookat:=xlPart, _
            searchdirection:=xlNext, _
            MatchCase:=False, _
            MatchByte:=False)
    If Not mykekka Is Nothing Then
    myfirst = mykekka.Address

    Do
    
    mykekka.Font.ColorIndex = 5
    lRow2 = Worksheets("sheet2").Range("c" & Rows.Count).End(xlUp).Row
    Worksheets("sheet2").Range("c" & lRow2 + 1).Offset(, 5).Value = _
                    mykekka.Value
    Worksheets("sheet2").Range("c" & lRow2 + 1).Value = _
                    mykekka.Offset(, 5).Value
    Set mykekka = Worksheets("sheet1").Range("c:c") _
            .FindNext(after:=mykekka)
    
    Loop While Not mykekka Is Nothing And _
            mykekka.Address <> myfirst
Else
    lRow2 = Worksheets("sheet2").Range("c" & Rows.Count).End(xlUp).Row
    Worksheets("sheet2").Range("c" & lRow2 + 1).Offset(, 5).Value = _
                    mykekka.Value
    Worksheets("sheet2").Range("c" & lRow2 + 1).Value = _
                    mykekka.Offset(, 5).Value
    
    End If
    Next i
    End Sub

実行すると
    C列    H列
    1    A
    1    A
    2    B
    2    B
    3    C
    3    C
    4    D
    4    D
    5    E
    5    E
    6    F
    6    F
    1    A
    1    A
    2    B
    2    B
    3    C
    3    C
    4    D
    4    D
    5    E
    5    E
    6    F
    6    F

のように同じ文字がある分だけ検索して書き出してしまいます、当たり前ですけど^^;
そこで一度検索した文字は文字の色を変えて次は検索しないようにと考えてはみたものの、一向にどの様に処理させればいいかが思い浮かびません。

どの様に処理させれば目的の形になるかご教授頂ければ幸いです。
勉強中の私が考えたマクロもかなり見苦しく間違った文面かとは思いますがよろしくお願いいたします。
0 hits

【56185】文字の検索〜他シートへの書き出しについて。 瞬希 08/6/8(日) 14:12 質問
【56186】Re:文字の検索〜他シートへの書き出しにつ... かみちゃん 08/6/8(日) 14:24 発言
【56189】Re:文字の検索〜他シートへの書き出しにつ... 瞬希 08/6/8(日) 14:58 お礼
【56190】Re:文字の検索〜他シートへの書き出しにつ... かみちゃん 08/6/8(日) 15:18 発言
【56191】Re:文字の検索〜他シートへの書き出しにつ... 瞬希 08/6/8(日) 15:25 お礼
【56194】Re:文字の検索〜他シートへの書き出しにつ... kanabun 08/6/8(日) 15:49 発言
【56195】Re:文字の検索〜他シートへの書き出しにつ... 瞬希 08/6/8(日) 17:24 お礼

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