マクロを簡潔にしたいので教えてください。
Sub 記入()
Dim testno As String
Dim testrow As Long
Dim basedata(1 To 10) As String
Dim weight(1 To 16) As Double
Sheets("sh3").Select
'(1)
testno = Range("B23").Value 'No.
Sheets("sh1").Select
For i = 65535 To 6 Step -1
If CStr(Cells(i, 1)) = Trim(testno) Then
testrow = i
Exit For
End If
Next i
If i = 5 Then
MsgBox ("?")
End
End If
For i = 1 To 10
basedata(i) = Cells(testrow, i + 1)
Next i
'(2)
Sheets("sh2").Select
For i = 65535 To 6 Step -1
If CStr(Cells(i, 1)) = Trim(testno) Then
testrow = i
Exit For
End If
Next i
If i = 5 Then
MsgBox ("?")
End
End If
For i = 1 To 6
weight(i) = Cells(testrow, i + 1)
Next i
For i = 7 To 12
weight(i) = Cells(testrow, i + 2)
Next i
weight(13) = Application.WorksheetFunction.Max(weight(1), weight(2), weight(3), weight(4), weight(5), weight(6))
weight(14) = Application.WorksheetFunction.Min(weight(1), weight(2), weight(3), weight(4), weight(5), weight(6))
weight(15) = Application.WorksheetFunction.Max(weight(7), weight(8), weight(9), weight(10), weight(11), weight(12))
weight(16) = Application.WorksheetFunction.Min(weight(7), weight(8), weight(9), weight(10), weight(11), weight(12))
Sheets("sheet3").Select
Cells(3, 1) = testno
For i = 1 To 10
Cells(3, i + 1) = basedata(i)
Next i
For i = 1 To 16
Cells(3, i + 11) = weight(i)
Next i
Sheets("sh3").Select
Erase basedata
Erase weight
'(1)
testno = Range("B24").Value 'No.
Sheets("sh1").Select
For i = 65535 To 6 Step -1
If CStr(Cells(i, 1)) = Trim(testno) Then
testrow = i
Exit For
End If
Next i
If i = 5 Then
MsgBox ("?")
End
End If
For i = 1 To 10
basedata(i) = Cells(testrow, i + 1)
Next i
'(2)
Sheets("sh2").Select
For i = 65535 To 6 Step -1
If CStr(Cells(i, 1)) = Trim(testno) Then
testrow = i
Exit For
End If
Next i
If i = 5 Then
MsgBox ("?")
End
End If
For i = 1 To 6
weight(i) = Cells(testrow, i + 1)
Next i
For i = 7 To 12
weight(i) = Cells(testrow, i + 2)
Next i
weight(13) = Application.WorksheetFunction.Max(weight(1), weight(2), weight(3), weight(4), weight(5), weight(6))
weight(14) = Application.WorksheetFunction.Min(weight(1), weight(2), weight(3), weight(4), weight(5), weight(6))
weight(15) = Application.WorksheetFunction.Max(weight(7), weight(8), weight(9), weight(10), weight(11), weight(12))
weight(16) = Application.WorksheetFunction.Min(weight(7), weight(8), weight(9), weight(10), weight(11), weight(12))
Sheets("sh3").Select
Cells(4, 1) = testno
For i = 1 To 10
Cells(4, i + 1) = basedata(i)
Next i
For i = 1 To 16
Cells(4, i + 11) = weight(i)
Next i
Sheets("sh3").Select
Erase basedata
Erase weight
この間同様文12個あり
'(1)
testno = Range("B37").Value
If testno = "" Then
End
End If
Sheets("sh1").Select
For i = 65535 To 6 Step -1
If CStr(Cells(i, 1)) = Trim(testno) Then
testrow = i
Exit For
End If
Next i
If i = 5 Then
MsgBox ("?")
End
End If
For i = 1 To 10
basedata(i) = Cells(testrow, i + 1)
Next i
'(2)
Sheets("sh2").Select
For i = 65535 To 6 Step -1
If CStr(Cells(i, 1)) = Trim(testno) Then
testrow = i
Exit For
End If
Next i
If i = 5 Then
MsgBox ("?")
End
End If
For i = 1 To 6
weight(i) = Cells(testrow, i + 1)
Next i
For i = 7 To 12
weight(i) = Cells(testrow, i + 2)
Next i
weight(13) = Application.WorksheetFunction.Max(weight(1), weight(2), weight(3), weight(4), weight(5), weight(6))
weight(14) = Application.WorksheetFunction.Min(weight(1), weight(2), weight(3), weight(4), weight(5), weight(6))
weight(15) = Application.WorksheetFunction.Max(weight(7), weight(8), weight(9), weight(10), weight(11), weight(12))
weight(16) = Application.WorksheetFunction.Min(weight(7), weight(8), weight(9), weight(10), weight(11), weight(12))
Sheets("sh3").Select
Cells(17, 1) = testno
For i = 1 To 10
Cells(17, i + 1) = basedata(i)
Next i
For i = 1 To 16
Cells(17, i + 11) = weight(i)
Next i
End Sub
お礼
ご指導、ありがとうございます。 ２番目の方法は思い浮かびませんでした。 ただ、やはりご指摘の通り、条件が多い場合は避けたほうがよいでしょうね。