Excel VBA質問箱 IV

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

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


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

5634 / 76732

←次へ　｜　前へ→


	【76706】Re:Excel2010 データインポートの際データがない時にファイルを閉じたい

β - 15/3/1(日) 7:56 -


	引用なし

	パスワード

▼りえさん：

ご希望なので。
先にコメントしたところも含めて、コードは、すべて元のままにしてあります。
気になるところも多々ありますが・・・・・・
Sheet1 は必ず処理されるんだということですから、Sheet2　の部分だけを以下。

　　'sheet2
　　Dim ws3 As Worksheet, ws4 As Worksheet
　　Dim r1 As Range
　　Dim n1 As Long
　　Dim i1 As Long, j1 As Long, k1 As Long
　　Dim done As Boolean　　　　 '★
　　
　　Set ws3 = Workbooks("C.xls").Worksheets("Sheet2")
　　Set ws4 = Workbooks("B.xls").Worksheets("Sheet2")
　　Set r1 = ws4.Range("A:I").Find("*", , xlValues, xlPart, xlByRows, xlPrevious)
　　
　　If Not r1 Is Nothing Then　 '★
　　
　　　　n1 = Int((r1.Row - 2) / 20)
　　　　
　　　　If n1 >= 0 Then　　　　 '★
　　　　　　
　　　　　　done = True　　　　 '★
　　　　　　
　　　　　　Application.ScreenUpdating = False
　　　　　　For i1 = 0 To n1
　　　　　　　　If i1 > 0 Then ws3.Range("A1:J33").Copy ws3.Cells(33 * i1 + 1, 1)
　　　　　　　　For j1 = 1 To 9
　　　　　　　　　　If j1 = 1 Then k1 = j1 Else k1 = j1 + 1
　　　　　　　　　　ws3.Cells(33 * i1 + 12, k1).Resize(20).Value = _
　　　　　　　　　　ws4.Cells(20 * i1 + 2, j1).Resize(20).Value
　　　　　　　　Next
　　　　　　Next
　　　　　　
　　　　　　Dim x1 As Long
　　　　　　For x1 = 1 To Cells(Rows.Count, 10).End(xlUp).Row
　　　　　　　　If Range("G" & x1).Value = "数" Then
　　　　　　　　　　Range("J" & x1).Value = "送"
　　　　　　　　
　　　　　　　　End If
　　　　　　Next
　　　　　　
　　　　End If　　　'★
　　　　
　　End If　　　　　'★
　　
　　Workbooks("C.xls").Close SaveChanges:=True
　　
　　Workbooks("B.xls").Close SaveChanges:=False
　　
　　Application.ScreenUpdating = True
　　
　　If done Then
　　　　MsgBox "終わりました"
　　Else
　　　　MsgBox "Sheet2に処理すべきデータはありませんでした"
　　End If

263 hits

▼

【76699】Excel2010 データインポートの際データがない時にファイルを閉じたい りえ 15/3/1(日) 4:58