| |
>▼こもと さん：
いろいろ教えてもらったんですが、もう一つ作らないといけないパターンがありまして…
これがどうもうまくいかず悩んでいます
【シート1】
A列 B列
__________親名前____子名前_______________
|
1行 | AAA BBB
2行 | BBB CABBB ←削除（CAから始まる為、BBBがキーとなってます）
3行 | BBB CCC ←削除
4行 | CCC DDD ←削除
5行 | BBB EEE ←削除
6行 | EEE FFF ←削除
7行 | FFF GGG ←削除
8行 | HHH RRR
9行 | RRR TTT
10行| EEE PPP ←削除
11行| WWW YYY
12行| YYY ABC
13行| YYY CAABC ←削除（CAから始まる為、ABCがキーとなってます）
14行| ABC EFG ←削除
上記のように、[シート1]の中のB列に"CA"からはじまる名前があり、この"CA"を抜いた名前と繋がっているものを
順番に削除していきたいのですが、うまくいきません
例）CABBB ⇒ BBBがキーとなります
前に教えてもらったＶＢＡを少し改造してみました
何でうまくいかないのか、伝授して頂けるとありがたいです
Sub test()
Dim myD As Object, i As Long, tbl
Dim MyLen As Integer
Dim MyCA As Variant
Set myD = CreateObject("Scripting.Dictionary")
'========================================================================
tbl = Worksheets(2).Range("A2").CurrentRegion.Columns("A:B").Value
For i = 1 To UBound(tbl)
If Left(Cells(i, 2).Value, 2) = "CA" Then
MyLen = Len(Cells(i, 2))
MyCA = Right(Cells(i, 2).Value, MyLen - 2)
For q = 1 To UBound(tbl)
If Cells(q, 2).Value = MyCA Then
If Not myD.exists(tbl(q, 2)) Then
myD.Add tbl(q, 2), ""
End If
Exit For
End If
Next q
End If
' myD.Add tbl(i, 1), ""
Next i
With Worksheets(2)
tbl = .Range("A2").CurrentRegion.Columns("A:B").Value
For q = 1 To UBound(tbl)
If myD.exists(tbl(q, 1)) Then
If Not myD.exists(tbl(q, 2)) Then
myD.Add tbl(q, 2), ""
End If
End If
Next q
For q = UBound(tbl) To 1 Step -1
If myD.exists(tbl(q, 1)) Then Range("C" & q).Value = "X"
Next q
End With
End Sub
|
|
たつ
- 09/11/4(水) 8:39 -
