|
▼kazu さん:
>Sub Sample()
>Dim buf2 As String
>
> ChDir "C:\"
> buf1 = Application.GetOpenFilename("*.txt,*.txt")
> If buf1 = "False" Then Exit Sub
> Workbooks.OpenText FileName:=buf1, _
> Origin:=xlWindows, _
> StartRow:=1, _
> DataType:=xlDelimited, _
> TextQualifier:=xlDoubleQuote, _
> ConsecutiveDelimiter:=False, _
> Tab:=False, _
> Semicolon:=False, _
> Comma:=True, _
> Space:=False, _
> Other:=False, _
> FieldInfo:=Array(Array(1, 1), Array(2, 1), _
> Array(3, 1), Array(4, 1), _
> Array(5, 1), Array(6, 1), _
> Array(7, 1), Array(8, 1))
>' TrailingMinusNumbers:=True
>
>
> Set ObjSht1 = ActiveWorkbook.ActiveSheet
>
> ChDir "C:\"
> buf2 = Application.GetOpenFilename("*.xls,*.xls")
> If buf2 = "False" Then Exit Sub
> Workbooks.Open buf2
>
> Set ObjBook1 = ActiveWorkbook
>
> For Each Cel In ObjSht1.Range(ObjSht1.Cells(1, 1), ObjSht1.Cells(65000, 1).End(xlUp))
> If 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
> 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
>
> ObjBook1.Close True
> Set ObjBook1 = Nothing
> ObjSht1.Application.ActiveWorkbook.Close False
> Set ObjSht1 = Nothing
>End Sub
なんですけど・・・
Set Cel2 = ObjBook1.Sheets("野菜").Columns(1).FindNext(Cel2)
って
Set Cel2 = ObjBook1.Sheets("果物").Columns(1).FindNext(Cel2)
ですよね??
モジュールに保存処理、振り分け処理をした場合ってどんな感じになるか教えていただけませんか??
お手数ですがよろしくおねがいします。
|
|