| |
皆様始めまして、1ヶ月ほど前からvbaに取り組んでいます。
vbaの辞典やネットでもかなり調べてみたのですが全く作業が進展しなくなってしまいました、皆様に知恵をお借りしたいと思い投稿させて頂きましたよろしくお願いいたします。
ブックのシート1のＣ列に文字が入力されています、Ｈ列にも文字が入力されています。
(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列 Ｈ列
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
のように同じ文字がある分だけ検索して書き出してしまいます、当たり前ですけど＾＾；
そこで一度検索した文字は文字の色を変えて次は検索しないようにと考えてはみたものの、一向にどの様に処理させればいいかが思い浮かびません。
どの様に処理させれば目的の形になるかご教授頂ければ幸いです。
勉強中の私が考えたマクロもかなり見苦しく間違った文面かとは思いますがよろしくお願いいたします。
|
|
瞬希
- 08/6/8(日) 14:12 -
