|
暗中模索状態になり解決できず、皆さんのアドバイスをお願します。
2個のFind検索にしたのは、1個の場合は応用できるのではないかと考えてのですが。
(例)
Dim MaxRows As Long
Dim y As Integer
Dim WorkArea As String
Dim CellAddress As String
Dim Result As Variant, Result2 As Variant
Dim StrCount As String
MaxRows = ActiveSheet.UsedRange.Rows.Count
y = MaxRows
WorkArea = "B1:B" & MaxRows
Set Result = ActiveSheet.Range(WorkArea).Find(what:="果物")
If Result Is Nothing Then
Else
CellAddress = Result.Address
End If
StrCount = Len(CellAddress)
CellAddress = Right(CellAddress, StrCount - 3)
WorkArea = "B" & CellAddress & ":C" & MaxRows
Set Result2 = ActiveSheet.Range(WorkArea).Find(what:="りんご", LookAt:=xlWhole)
If Result2 Is Nothing Then
Else
CellAddress = Result2.Address
End If
Do
Set Result2 = ActiveSheet.Range(WorkArea).FindNext(Result2)
Loop While Not Result2 Is Nothing And Result2.Address <> CellAddress
CellAddress = Right(CellAddress, StrCount - 3)
CellAddress = "A" & CellAddress
ActiveSheet.Range("E2").Value = ActiveSheet.Range(CellAddress)
CellAddress = Right(CellAddress, StrCount - 3)
CellAddress = "D" & CellAddress
ActiveSheet.Range("F2").Value = ActiveSheet.Range(CellAddress)
End sub
このコードは中途半端なものです。いろいろ試みたのですが駄目でした。
Resizeの場合、2個のFindになると出来たり出来なかったりで原因がわかりません。
もともと2個のFindからのFindNextのコード利用は無理なのでしょうか。
ご教示をお願いします。
|
|