Excel VBA質問箱 IV

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

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


57667 / 76732 ←次へ | 前へ→

【23799】さらにパワーアップ
発言  sakura  - 05/4/4(月) 19:38 -

引用なし
パスワード
   ▼sakura さん:
さらにVBAのパワーアップを試みたいのですが・・・

ファイルA.txt
 | A | B | C | D | E | F |
1| 種類 | 名 | 在庫 |   |   |   |
2| 果物 |リンゴ| 1 |   |   |   |
3| 果物 |メロン| 4 |   |   |   |
4| 果物 | モモ | 3 |   |   |   |
5| 野菜 |トマト| 2 |   |   |   |
6| 野菜 | 白菜 | 1 |   |   |   |
7| 野菜 |玉ねぎ| 3 |   |   |   |
8| 果物 |バナナ| 2 |   |   |   |
9| 野菜 | 大根 | 3 |   |   |   |
10| 野菜 | ナス | 1 |   |   |   |
のエクセルに対して以下VBAを実行すると・・・

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


をbookA.xls
 | A | B | C | D | E | F |
1| 名 | 在庫 |   |   |   |   |
2|リンゴ| 1 |   |   |   |   |
3|メロン| 4 |   |   |   |   |
4| モモ | 3 |   |   |   |   |
5|バナナ| 2 |   |   |   |   |
6|   |   |   |   |   |   |
7|   |   |   |   |   |   |
8|   |   |   |   |   |   |
9|   |   |   |   |   |   |
10|   |   |   |   |   |   |
    ______________________________________
\果物/\野菜/



 | A | B | C | D | E | F |
1| 名 | 在庫 |   |   |   |   |
2|トマト| 2 |   |   |   |   |
3| 白菜 | 1 |   |   |   |   |
4|玉ねぎ| 3 |   |   |   |   |
5| 大根 | 3 |   |   |   |   |
6| ナス | 1 |   |   |   |   |
7|   |   |   |   |   |   |
8|   |   |   |   |   |   |
9|   |   |   |   |   |   |
10|   |   |   |   |   |   |
_______    _______________________________
\果物/\野菜/

というような形になるのですが・・・
(初めの読み込みでファイルA.txt、二回目の読み込みでbookA.xlsを読み込んでます。)


仮に下記ファイルA.txtのようにゴーヤがあったとして・・・

ファイルA.txt
 | A | B | C | D | E | F |
1| 種類 | 名 | 在庫 |   |   |   |
2| 果物 |リンゴ| 1 |   |   |   |
3| 果物 |メロン| 4 |   |   |   |
4| 果物 | モモ | 3 |   |   |   |
5| 野菜 |トマト| 2 |   |   |   |
6| 野菜 | 白菜 | 1 |   |   |   |
7| 野菜 |玉ねぎ| 3 |   |   |   |
8| 果物 |バナナ| 2 |   |   |   |
9| 野菜 | 大根 | 3 |   |   |   |
10| 野菜 | ナス | 1 |   |   |   |
11| 野菜 |ゴーヤ| 2 |   |   |   |

下記のbookA.xlsのA列にゴーヤの項目がなかった場合
bookA.xls
 | A | B | C | D | E | F |
1| 名 | 在庫 |   |   |   |   |
2|トマト| 2 |   |   |   |   |
3| 白菜 | 1 |   |   |   |   |
4|玉ねぎ| 3 |   |   |   |   |
5| 大根 | 3 |   |   |   |   |
6| ナス | 1 |   |   |   |   |
7|   |   |   |   |   |   |
8|   |   |   |   |   |   |
9|   |   |   |   |   |   |
10|   |   |   |   |   |   |
_______    _______________________________
\果物/\野菜/

さっきのマクロでは何も操作されないのですが・・・

項目にない場合は・・・
以下bookA.xlsのように一番下の項目(この場合A7)にゴーヤという項目を
付け足して在庫数もつけたしたいのです。
bookA.xls
 | A | B | C | D | E | F |
1| 名 | 在庫 |   |   |   |   |
2|トマト| 2 |   |   |   |   |
3| 白菜 | 1 |   |   |   |   |
4|玉ねぎ| 3 |   |   |   |   |
5| 大根 | 3 |   |   |   |   |
6| ナス | 1 |   |   |   |   |
7|ゴーヤ| 2 |   |   |   |   |
8|   |   |   |   |   |   |
9|   |   |   |   |   |   |
10|   |   |   |   |   |   |
_______    _______________________________
\果物/\野菜/

上記マクロを改良すればなんとかできそうではあると思うのですが・・・

アドバイスをいただけたらありがたいです。

1 hits

【23420】他のbookに値を書き込む方法 sakura 05/3/22(火) 18:01 質問
【23421】Re:他のbookに値を書き込む方法 kazu 05/3/22(火) 18:57 発言
【23459】Re:他のbookに値を書き込む方法 sakura 05/3/24(木) 13:20 質問
【23460】Re:他のbookに値を書き込む方法 sakura 05/3/24(木) 13:42 質問
【23464】Re:他のbookに値を書き込む方法 Jaka 05/3/24(木) 14:25 回答
【23491】Re:他のbookに値を書き込む方法 sakura 05/3/24(木) 17:30 発言
【23492】Re:他のbookに値を書き込む方法 Jaka 05/3/24(木) 17:39 発言
【23501】Re:他のbookに値を書き込む方法 sakura 05/3/24(木) 19:09 発言
【23522】Re:他のbookに値を書き込む方法 Jaka 05/3/25(金) 14:19 回答
【23532】Re:他のbookに値を書き込む方法 sakura 05/3/25(金) 18:00 発言
【23595】Re:他のbookに値を書き込む方法 Jaka 05/3/29(火) 17:06 回答
【23497】Re:他のbookに値を書き込む方法 kazu 05/3/24(木) 18:12 発言
【23502】Re:他のbookに値を書き込む方法 sakura 05/3/24(木) 19:11 発言
【23537】Re:他のbookに値を書き込む方法 sakura 05/3/25(金) 19:07 発言
【23559】Re:他のbookに値を書き込む方法 kazu 05/3/28(月) 12:48 発言
【23797】Re:他のbookに値を書き込む方法 sakura 05/4/4(月) 19:00 質問
【23799】さらにパワーアップ sakura 05/4/4(月) 19:38 発言
【23890】Re:さらにパワーアップ sakura 05/4/6(水) 17:27 お礼

57667 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free