Excel VBA質問箱 IV

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

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


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

5636 / 76732

←次へ　｜　前へ→


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

りえ - 15/3/1(日) 7:36 -


	引用なし

	パスワード

β様

回答ありがとうございます

私が質問をさせて頂いたｺｰﾄﾞの構成のままで
お願い出来ませんか？

各ｼｰﾄには罫線で囲われた表があり、
20行毎にデータをインポートしています
各ｼｰﾄのフォーマットを維持したままやりたく思います

お手数ばかりおかけして申し訳ありません

>了解です。
>
>想像で書いているところもありますので当方の誤解あれば指摘願います。
>また、書いただけで動かしてはいません。不具合あれば指摘願います。
>
>・もとのコードの構成のまま、途中で処理をうちきらずに、続行させることもできますが
>　全体の制御が見えにくくなると思いましたので、処理部分をサブプロシジャ
>　（実行したかどうかの戻り値付）にして外だしにしました。
>
>・かつ、Sheet1側、Sheet2側ともに、対象シートが異なるだけで、全く同じ処理でしたので
>　一本化しました。
>
>・コード中にもコメント入れましたが
>
>　　For x = 1 To Cells(Rows.Count, 10).End(xlUp).Row
>　　　　If Range("G" & x).Value = "数" Then
>　　　　　　Range("J" & x).Value = "送"
>　　　　End If
>　　Next
>
>　ここだけ、それぞれのセルが、どのシートかの指定がありません。
>　追加しておいてください。
>
>Sub ボタン1_Click()
>　　Dim done As Boolean
>　　Dim bkB As Workbook
>　　Dim bkC As Workbook
>　　
>　　Application.ScreenUpdating = False
>　　
>　　Set bkB = Workbooks.Open("C:\東京\B.xls")
>　　Set bkC = Workbooks.Open("C:\東京\C.xls")
>　　
>　　'sheet1
>　　done = Proc(bkC.Worksheets("Sheet1"), bkB.Worksheets("Sheet1"))
>　　'sheet2
>　　done = Proc(bkC.Worksheets("Sheet2"), bkB.Worksheets("Sheet2"))
>　　
>　　bkB.Close SaveChanges:=False
>
>　　If done Then
>　　　　Application.DisplayAlerts = False
>　　　　bkC.SaveAs Filename:="\\サーバ名\フォルダ名1\共有フォルダ名2\" & bkC.Name
>　　　　Application.DisplayAlerts = True
>　　End If
>　　
>　　bkC.Close SaveChanges:=False
>　　
>　　Application.ScreenUpdating = True
>　　
>　　If done Then
>　　　　MsgBox "終わりました"
>　　Else
>　　　　MsgBox "処理すべきデータがありませんでした"
>　　End If
>　　
>End Sub
>
>Private Function Proc(sh1 As Worksheet, sh2 As Worksheet) As Boolean
>
>　　Dim r As Range
>　　Dim n As Long
>　　Dim i As Long, j As Long, k As Long
>　　Dim x As Long
>　　
>　　Set r = sh2.Range("A:I").Find("*", , xlValues, xlPart, xlByRows, xlPrevious)
>　　
>　　If r Is Nothing Then Exit Function
>　　
>　　n = Int((r.Row - 2) / 20)
>　　If n < 0 Then Exit Function
>　　
>　　Proc = True　　 '★実行された
>
>　　For i = 0 To n
>　　　　If i > 0 Then sh1.Range("A1:J33").Copy sh1.Cells(33 * i + 1, 1)
>　　　　For j = 1 To 9
>　　　　　　If j = 1 Then k = j Else k = j + 1
>　　　　　　sh1.Cells(33 * i + 12, k).Resize(20).Value = _
>　　　　　　sh2.Cells(20 * i + 2, j).Resize(20).Value
>　　　　Next
>　　Next
>　　
>　　'★以下の Cellsと2つのRange。どのシートでしょう？ここにも、sh1. なり sh2.なりを付けてください。
>　　
>　　For x = 1 To Cells(Rows.Count, 10).End(xlUp).Row
>　　　　If Range("G" & x).Value = "数" Then
>　　　　　　Range("J" & x).Value = "送"
>　　　　End If
>　　Next
>
>End Function

265 hits

▼

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