Excel VBA質問箱 IV

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

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


57669 / 76732 ←次へ | 前へ→

【23797】Re:他のbookに値を書き込む方法
質問  sakura  - 05/4/4(月) 19:00 -

引用なし
パスワード
   ▼kazu さん:

kazuさん返事遅くなりまして大変申し訳なかったですが・・・
以下の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

さらにパワーアップをさせたいのですが・・・

次レスで説明させてもらいます。
2 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 お礼

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