|
sakura さんこんにちは。
とりあえず私の書いたコードについて簡単に説明いれときますね。
Celは 開いたテキストファイルの A1 → A2 → A3 ・・・・・・とA列の最終行迄1セルづつ変化していきます。
For Each Cel In ObjSht1.Range(ObjSht1.Cells(1, 1), ObjSht1.Cells(65000, 1).End(xlUp))
Celの値が野菜だった場合
If Trim(Cel.Value) = "野菜" Then
Celのひとつ右の列(CelがA2の場合B2セル)と同じ値が入っているセルを野菜シートのA列から検索し、結果をCel2 に格納(*1)
(無かった場合はNothingが格納されます。)
Set Cel2 = ObjBook1.Sheets("野菜").Columns(1).Find(Trim(Cel.Offset(0, 1).Value))
Cel2 がNothingになる迄繰り返す
Do Until Cel2 Is Nothing
Cel2 の行にCelの行をコピー&ペースト
Cel.EntireRow.Copy Cel2.EntireRow
*1と同じ条件で次に同じ値が入っているセルを検索
Set Cel2 = ObjBook1.Sheets("野菜").Columns(1).FindNext(Cel2)
Loop
ElseIf Trim(Cel.Value) = "果物" Then
Set Cel2 = ObjBook1.Sheets("果物").Columns(1).Find(Trim(Cel.Offset(0, 1).Value))
Do Until Cel2 Is Nothing
Cel.EntireRow.Copy Cel2.EntireRow
Set Cel2 = ObjBook1.Sheets("果物").Columns(1).FindNext(Cel2)
Loop
End If
Set Cel2 = Nothing
Next
野菜シート,果物シートのあるBookを閉じる (上書きあり)
ObjBook1.Close True
Set ObjBook1 = Nothing
ObjSht1.Application.ActiveWorkbook.Close False
Set ObjSht1 = Nothing
|
|