| |
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
|
|
kazu
- 05/3/24(木) 18:12 -
