|
β様
ありがとうございました
▼β さん:
>▼りえ さん:
>
>ご希望なので。
>先にコメントしたところも含めて、コードは、すべて元のままにしてあります。
>気になるところも多々ありますが・・・・・・
>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
|
|