| |
▼kazu さん：
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))
If Not Cel2 Is Nothing Then
FstCel2 = Cel2.Row
Do
Cel2.Offset(0, 2).Value = Cel.Offset(0, 3).Value
Set Cel2 = ObjBook1.Sheets("野菜").Columns(1).FindNext(Cel2)
Loop Until Cel2 Is Nothing Or Cel2.Row = FstCel2
End If
ElseIf Trim(Cel.Value) = "果物" Then
Set Cel2 = ObjBook1.Sheets("果物").Columns(1).Find(Trim(Cel.Offset(0, 1).Value))
If Not Cel2 Is Nothing Then
FstCel2 = Cel2.Row
Do
Cel2.Offset(0, 2).Value = Cel.Offset(0, 3).Value
Set Cel2 = ObjBook1.Sheets("果物").Columns(1).FindNext(Cel2)
Loop Until Cel2 Is Nothing Or Cel2.Row = FstCel2
End If
End If
Set Cel2 = Nothing
Next
ObjBook1.Close True
Set ObjBook1 = Nothing
ObjSht1.Application.ActiveWorkbook.Close False
Set ObjSht1 = Nothing
End Sub
さらにパワーアップをさせたいのですが・・・
次レスで説明させてもらいます。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
