| |
▼りえ さん：
了解です。
想像で書いているところもありますので当方の誤解あれば指摘願います。
また、書いただけで動かしてはいません。不具合あれば指摘願います。
・もとのコードの構成のまま、途中で処理をうちきらずに、続行させることもできますが
全体の制御が見えにくくなると思いましたので、処理部分をサブプロシジャ
（実行したかどうかの戻り値付）にして外だしにしました。
・かつ、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
|
|
β
- 15/3/1(日) 6:49 -
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
