処理速度を速くする方法教えてください。
Private Sub CommandButton1_Click()
Dim irow As Long
Dim Celldata(1 To 6) As Double
Dim ekimen(1 To 6) As String '高さ読込み
If TextBox8.Value = "" Then
MsgBox ("No.を入力")
End
End If
If TextBox9.Value = "" Then
MsgBox ("温度を入力")
End
End If
If TextBox10.Value = "" Then
MsgBox ("係数を入力")
End
End If
Celldata(1) = TextBox1.Value + (TextBox7.Value - TextBox9.Value) * TextBox10.Value
Celldata(2) = TextBox2.Value + (TextBox7.Value - TextBox9.Value) * TextBox10.Value
Celldata(3) = TextBox3.Value + (TextBox7.Value - TextBox9.Value) * TextBox10.Value
Celldata(4) = TextBox4.Value + (TextBox7.Value - TextBox9.Value) * TextBox10.Value
Celldata(5) = TextBox5.Value + (TextBox7.Value - TextBox9.Value) * TextBox10.Value
Celldata(6) = TextBox6.Value + (TextBox7.Value - TextBox9.Value) * TextBox10.Value
'入力と修正
Dim i As Long
'最終行から試験Noが一致するものを探す
For i = 65535 To 6 Step -1
If CStr(Cells(i, 1)) = Trim(TextBox8.Value) Then
Set myrange = Sheets("データ").Cells(i - 1, 1)
'記入セルがoffset(1,x)になっているため、i-1にしています。
Exit For
End If
Next i
'Noが一致しない場合、最終行を記入セルに設定する。
If i = 5 Then
Set myrange = Sheets("データ").Range("A65536").End(xlUp)
End If
'ワークシートへの転記
With myrange
.Offset(1, 0).Value = TextBox8.Value '----No.
.Offset(1, 1).Value = Celldata(1) '----1計測
.Offset(1, 2).Value = Celldata(2) '----2計測
.Offset(1, 3).Value = Celldata(3) '----3ル計測
.Offset(1, 4).Value = Celldata(4) '----4計測
.Offset(1, 5).Value = Celldata(5) '----5計測
.Offset(1, 6).Value = Celldata(6) '----6計測
.Offset(1, 13).Value = TextBox1.Value '----1追加
.Offset(1, 14).Value = TextBox2.Value '----2追加
.Offset(1, 15).Value = TextBox3.Value '----3追加
.Offset(1, 16).Value = TextBox4.Value '----4追加
.Offset(1, 17).Value = TextBox5.Value '----5追加
.Offset(1, 18).Value = TextBox6.Value '----6追加
.Offset(1, 19).Value = TextBox7.Value '---温度
.Offset(1, 20).Value = TextBox11.Value '----1高さ
.Offset(1, 21).Value = TextBox12.Value '----2高さ
.Offset(1, 22).Value = TextBox13.Value '----3高さ
.Offset(1, 23).Value = TextBox14.Value '----4高さ
.Offset(1, 24).Value = TextBox15.Value '----5高さ
.Offset(1, 25).Value = TextBox16.Value '----6高さ
'入力ボックスのクリア
TextBox1.Value = "" '----1セル
TextBox2.Value = "" '----2セル
TextBox3.Value = "" '----3セル
TextBox4.Value = "" '----4セル
TextBox5.Value = "" '----5セル
TextBox6.Value = "" '----6セル
TextBox7.Value = "" '---温度
TextBox11.Value = "" '----1セル
TextBox12.Value = "" '----2セル
TextBox13.Value = "" '----3セル
TextBox14.Value = "" '----4セル
TextBox15.Value = "" '----5セル
TextBox16.Value = "" '----6セル
End With
'lblComment.Caption = "ワークシートに転記しました!"
End Sub
Private Sub CommandButton2_Click()
Dim i As Long
'入力チェック
If TextBox8.Value = "" Then
MsgBox ("No.を入力")
End
End If
If TextBox9.Value = "" Then
MsgBox ("温度を入力")
End
End If
If TextBox10.Value = "" Then
MsgBox ("係数を入力")
End
End If
For i = 65535 To 6 Step -1
If CStr(Cells(i, 1)) = Trim(TextBox8.Value) Then
Set myrange = Sheets("データ").Cells(i - 1, 1)
'記入セルがoffset(1,x)になっているため、i-1にしています。
Exit For
End If
Next i
'受付No.がない場合、終了します。
If i = 5 Then
MsgBox ("No.が見つかりません")
End
End If
'入力の処理と逆の処理を行います。
With myrange
TextBox1.Value = .Offset(1, 13).Value '---1計測
TextBox2.Value = .Offset(1, 14).Value '---2計測
TextBox3.Value = .Offset(1, 15).Value '---3計測
TextBox4.Value = .Offset(1, 16).Value '---4計測
TextBox5.Value = .Offset(1, 17).Value '---5計測
TextBox6.Value = .Offset(1, 18).Value '---6計測
TextBox7.Value = .Offset(1, 19).Value '---温度
TextBox11.Value = .Offset(1, 20).Value '---1高さ
TextBox12.Value = .Offset(1, 21).Value '---2高さ
TextBox13.Value = .Offset(1, 22).Value '---3高さ
TextBox14.Value = .Offset(1, 23).Value '---4高さ
TextBox15.Value = .Offset(1, 24).Value '---5高さ
TextBox16.Value = .Offset(1, 25).Value '---6高さ
End With
End Sub
お礼
さっそくのご返答ありがとうございました。 そうですね、ThisWorkbook.Pathで取得すればわかりますね! どうもありがとうございました。