Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

57673 / 76738

←次へ　｜　前へ→


	【23799】さらにパワーアップ

sakura - 05/4/4(月) 19:38 -


	引用なし

	パスワード

▼sakura さん：さらにVBAのパワーアップを試みたいのですが・・・ファイルＡ.txt 　|　Ａ　|　Ｂ　|　Ｃ　|　Ｄ　|　Ｅ　|　Ｆ　| １| 種類 |　名　| 在庫 |　　　|　　　|　　　| ２| 果物 |リンゴ|　１　|　　　|　　　|　　　| ３| 果物 |メロン|　４　|　　　|　　　|　　　| ４| 果物 | モモ |　３　|　　　|　　　|　　　| ５| 野菜 |トマト|　２　|　　　|　　　|　　　| ６| 野菜 | 白菜 |　１　|　　　|　　　|　　　| ７| 野菜 |玉ねぎ|　３　|　　　|　　　|　　　| ８| 果物 |バナナ|　２　|　　　|　　　|　　　| ９| 野菜 | 大根 |　３　|　　　|　　　|　　　| 10| 野菜 | ナス |　１　|　　　|　　　|　　　| のエクセルに対して以下ＶＢＡを実行すると・・・ 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 をbookＡ.xls 　|　Ａ　|　Ｂ　|　Ｃ　|　Ｄ　|　Ｅ　|　Ｆ　| １|　名　| 在庫 |　　　|　　　|　　　|　　　| ２|リンゴ|　１　|　　　|　　　|　　　|　　　| ３|メロン|　４　|　　　|　　　|　　　|　　　| ４| モモ |　３　|　　　|　　　|　　　|　　　| ５|バナナ|　２　|　　　|　　　|　　　|　　　| ６|　　　|　　　|　　　|　　　|　　　|　　　| ７|　　　|　　　|　　　|　　　|　　　|　　　| ８|　　　|　　　|　　　|　　　|　　　|　　　| ９|　　　|　　　|　　　|　　　|　　　|　　　| 10|　　　|　　　|　　　|　　　|　　　|　　　| 　　　 ______________________________________ ＼果物/＼野菜/ と　|　Ａ　|　Ｂ　|　Ｃ　|　Ｄ　|　Ｅ　|　Ｆ　| １|　名　| 在庫 |　　　|　　　|　　　|　　　| ２|トマト|　２　|　　　|　　　|　　　|　　　| ３| 白菜 |　１　|　　　|　　　|　　　|　　　| ４|玉ねぎ|　３　|　　　|　　　|　　　|　　　| ５| 大根 |　３　|　　　|　　　|　　　|　　　| ６| ナス |　１　|　　　|　　　|　　　|　　　| ７|　　　|　　　|　　　|　　　|　　　|　　　| ８|　　　|　　　|　　　|　　　|　　　|　　　| ９|　　　|　　　|　　　|　　　|　　　|　　　| 10|　　　|　　　|　　　|　　　|　　　|　　　| _______　　　 _______________________________ ＼果物/＼野菜/ というような形になるのですが・・・（初めの読み込みでファイルＡ.txt、二回目の読み込みでbookＡ.xlsを読み込んでます。）仮に下記ファイルＡ.txtのようにゴーヤがあったとして・・・ファイルＡ.txt 　|　Ａ　|　Ｂ　|　Ｃ　|　Ｄ　|　Ｅ　|　Ｆ　| １| 種類 |　名　| 在庫 |　　　|　　　|　　　| ２| 果物 |リンゴ|　１　|　　　|　　　|　　　| ３| 果物 |メロン|　４　|　　　|　　　|　　　| ４| 果物 | モモ |　３　|　　　|　　　|　　　| ５| 野菜 |トマト|　２　|　　　|　　　|　　　| ６| 野菜 | 白菜 |　１　|　　　|　　　|　　　| ７| 野菜 |玉ねぎ|　３　|　　　|　　　|　　　| ８| 果物 |バナナ|　２　|　　　|　　　|　　　| ９| 野菜 | 大根 |　３　|　　　|　　　|　　　| 10| 野菜 | ナス |　１　|　　　|　　　|　　　| 11| 野菜 |ゴーヤ|　２　|　　　|　　　|　　　| 下記のbookＡ.xlsのＡ列にゴーヤの項目がなかった場合 bookＡ.xls 　|　Ａ　|　Ｂ　|　Ｃ　|　Ｄ　|　Ｅ　|　Ｆ　| １|　名　| 在庫 |　　　|　　　|　　　|　　　| ２|トマト|　２　|　　　|　　　|　　　|　　　| ３| 白菜 |　１　|　　　|　　　|　　　|　　　| ４|玉ねぎ|　３　|　　　|　　　|　　　|　　　| ５| 大根 |　３　|　　　|　　　|　　　|　　　| ６| ナス |　１　|　　　|　　　|　　　|　　　| ７|　　　|　　　|　　　|　　　|　　　|　　　| ８|　　　|　　　|　　　|　　　|　　　|　　　| ９|　　　|　　　|　　　|　　　|　　　|　　　| 10|　　　|　　　|　　　|　　　|　　　|　　　| _______　　　 _______________________________ ＼果物/＼野菜/ さっきのマクロでは何も操作されないのですが・・・項目にない場合は・・・以下bookＡ.xlsのように一番下の項目（この場合Ａ７）にゴーヤという項目を付け足して在庫数もつけたしたいのです。 bookＡ.xls 　|　Ａ　|　Ｂ　|　Ｃ　|　Ｄ　|　Ｅ　|　Ｆ　| １|　名　| 在庫 |　　　|　　　|　　　|　　　| ２|トマト|　２　|　　　|　　　|　　　|　　　| ３| 白菜 |　１　|　　　|　　　|　　　|　　　| ４|玉ねぎ|　３　|　　　|　　　|　　　|　　　| ５| 大根 |　３　|　　　|　　　|　　　|　　　| ６| ナス |　１　|　　　|　　　|　　　|　　　| ７|ゴーヤ|　２　|　　　|　　　|　　　|　　　| ８|　　　|　　　|　　　|　　　|　　　|　　　| ９|　　　|　　　|　　　|　　　|　　　|　　　| 10|　　　|　　　|　　　|　　　|　　　|　　　| _______　　　 _______________________________ ＼果物/＼野菜/ 上記マクロを改良すればなんとかできそうではあると思うのですが・・・アドバイスをいただけたらありがたいです。