Excel VBA質問箱 IV

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

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


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

【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 お礼[未読]

【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

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

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

【56186】Re:文字の検索〜他シートへの書き出しに...
発言  かみちゃん  - 08/6/8(日) 14:24 -

引用なし
パスワード
   こんにちは。かみちゃん です。

>このシート1のC列の文字を上から連続で取得し、順番に検索させてシート2に

発想を大きく変えて、C列で並べ替えしてはいけないのでしょうか?

【56189】Re:文字の検索〜他シートへの書き出しに...
お礼  瞬希  - 08/6/8(日) 14:58 -

引用なし
パスワード
   ▼かみちゃん さん:
>こんにちは。かみちゃん です。
>
>>このシート1のC列の文字を上から連続で取得し、順番に検索させてシート2に
>
>発想を大きく変えて、C列で並べ替えしてはいけないのでしょうか?

かみちゃんさん迅速なレス大変ありがとう御座います。
本当に大きく発想が変わりましたね。

先ほどの文面では
このシート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
と書いたのですがまだこのマクロ完成しているわけではなくて本当にしたい作業は
    C列    H列
    1    A+A
    2    B+B
    3    C+C
    4    D+D
    5    E+E
    6    F+F
と書き出すことなんです、簡単に言うと在庫管理なんですけど。
全部聞くと自分の為にならないと思いまして^^;
あまりにもC列の情報が多いので出来れば他のシートに書き出す方法があればなぁと思っています。
よろしくお願いいたします。

【56190】Re:文字の検索〜他シートへの書き出しに...
発言  かみちゃん E-MAIL  - 08/6/8(日) 15:18 -

引用なし
パスワード
   こんにちは。かみちゃん です。

>>>このシート1のC列の文字を上から連続で取得し、順番に検索させてシート2に
>>
>>発想を大きく変えて、C列で並べ替えしてはいけないのでしょうか?
>
>かみちゃんさん迅速なレス大変ありがとう御座います。
>本当に大きく発想が変わりましたね。
>
>本当にしたい作業は
>    C列    H列
>    1    A+A
>    2    B+B
>    3    C+C
>    4    D+D
>    5    E+E
>    6    F+F
>と書き出すことなんです、簡単に言うと在庫管理なんですけど。

在庫管理なのかどうかよくわからないのですが、
C列で並び変わっているという前提で、以下のようなコードで上記のシートイメージ
のデータが得られると思います。

Sub Sample()
 Dim i As Long
 Dim lRow1 As Long
 Dim lRow2 As Long
 Dim srcname As String
 Dim strkekka As String
 Dim srcname_tmp As String
 
 lRow1 = Worksheets("Sheet1").Range("C" & Rows.Count).End(xlUp).Row
 lRow2 = Worksheets("Sheet2").Range("C" & Rows.Count).End(xlUp).Row
 For i = 2 To lRow1 + 1 Step 1
  srcname = Worksheets("Sheet1").Cells(i, 3).Value
  If srcname_tmp = "" Then
   srcname_tmp = srcname
  End If
  If srcname <> srcname_tmp Then
   Sheets("Sheet2").Cells(lRow2, "C").Value = srcname_tmp
   Sheets("Sheet2").Cells(lRow2, "H").Value = strkekka
   lRow2 = lRow2 + 1
   srcname_tmp = srcname
   strkekka = ""
  End If
  If strkekka <> "" Then
   strkekka = strkekka & "+"
  End If
  strkekka = strkekka & Worksheets("Sheet1").Cells(i, 8).Value
 Next
 MsgBox "処理を終了しました"
End Sub

【56191】Re:文字の検索〜他シートへの書き出しに...
お礼  瞬希  - 08/6/8(日) 15:25 -

引用なし
パスワード
   かみちゃんさん
本当に大変ありがとうございます。

ちょっとやってみます。

【56194】Re:文字の検索〜他シートへの書き出しに...
発言  kanabun  - 08/6/8(日) 15:49 -

引用なし
パスワード
   ▼瞬希 さん:
こんにちは。
▼かみちゃん さん:
よこから 失礼します。

Findメソッドの方法でも、書きだすだけならできないことはないと思います。
なぜ多重検索になってしまうのか、原因は見つかりましたか?
Findで見つかったらセルの書式を変えていますが、Do〜Loopのなかで
書式のチェックがなされていないからですよね。
書式を変えるのでもいいし、C列の範囲の値をいったん配列に退避しておいて、
Do〜FindNext〜Loop の中では 見つかったセルをClearContents していっても
いいと思います。(全セルの検索が終了したら 元の値を配列から書き戻します)

>本当にしたい作業は
>    C列    H列
>    1    A+A
>    2    B+B
>    3    C+C
>    4    D+D
>    5    E+E
>    6    F+F
>と書き出すことなんです

そういうときは Dictionaryオブジェクトを利用すると効率よいですよ。

Sub Try2()
 Dim dic As Object
 Dim vC, vH, cc As Range
 Dim i As Long, n As Long
 Dim ss As String
 
 With Worksheets("sheet1")
   Set cc = .Range("C2", .Cells(Rows.Count, "C").End(xlUp))
   vC = cc.Value
   vH = cc.Offset(, 5).Value
 End With
 Set dic = CreateObject("Scripting.Dictionary")
 For i = 1 To UBound(vC)
   If Not IsEmpty(vC(i, 1)) Then
     ss = dic(vC(i, 1))
     If Len(ss) Then ss = ss & "+"
     ss = ss & vH(i, 1)
     dic(vC(i, 1)) = ss
   End If
 Next
 n = dic.Count
 With Worksheets("Sheet2")
   .Range("C2").Resize(n).Value = Application.Transpose(dic.Keys)
   .Range("H2").Resize(n).Value = Application.Transpose(dic.Items)
 End With
 Beep
 Set dic = Nothing
End Sub

【56195】Re:文字の検索〜他シートへの書き出しに...
お礼  瞬希  - 08/6/8(日) 17:24 -

引用なし
パスワード
   kanabunさん、大変ありがとう御座います。

>なぜ多重検索になってしまうのか、原因は見つかりましたか?
まだ自信は無いのですが、for〜nextの型を使用しているから何時までも数値がある以上多重検索されているのだろうと自分的には考えています。

>Findで見つかったらセルの書式を変えていますが、Do〜Loopのなかで
>書式のチェックがなされていないからですよね。

はい。その通りだと思ってはいたのですがどうチェックしていいのか検討がつかなかったです。

>書式を変えるのでもいいし、C列の範囲の値をいったん配列に退避しておいて、
>Do〜FindNext〜Loop の中では 見つかったセルをClearContents していっても
>いいと思います。(全セルの検索が終了したら 元の値を配列から書き戻します)

凄いの一言です。
検索が終了したら元の値を書きもどすなんて考えかたが全く出来ませんでした。
言われてびっくりです。

>そういうときは Dictionaryオブジェクトを利用すると効率よいですよ。

本当にありがとう御座います。
もう一度kanabunさんに言われた事を「できる。大辞典」でしっかり調べなおして勉強いたします。

かみちゃんさん、kanabunさんお時間頂いてありがとうございました。

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