| |
皆様
お力をお貸し下さい。
以下が作成したモジュールです。
If文で、ある条件に応じて使用するシートを選択させて、コピー＆ペイストさせるという形で命令文を書いています。
If文の最初の命令文の中でのある部分の動作が、次の条件の場合でも同じ動作のものがあるので、この部分を重複して書かずにすむ方法がないかと思っています。
確か、該当の位置を指示して（最初の位置は、ＡＡＡ：などで表示し、終わりが解りません）、”go to AAA ”のように出来なかったでしょうか。
他にいい方法がありましら、ご教示いただけるとうれしいです。
宜しくお願いします。
****************************************************
Sub TESTEDM()
Dim flag As Boolean
Dim Fdir As String
Dim FPss As String
Dim FileName As String
Dim Opnbook As Workbook
Dim Z As Worksheet
Dim H As Worksheet
Dim sh1, sh5, Sh6, Sh7 As Worksheet
Dim 入力者 As String
Dim コメント As String
Dim メルアド As String
Dim 結果 As Long
Dim 確認 As Long
Dim 入力 As Long
Dim n As Integer
'チラついて五月蝿いのを防止
Application.ScreenUpdating = False
Fdir = "U:\マクロ作成中\"
FPss = Fdir & "リスト(てすと).xlsx"
FileName = FPss
flag = False
For Each Opnbook In Workbooks
If Opnbook.FullName = FileName Then
flag = True
Exit For
End If
Next Opnbook
If flag = False Then
Set Opnbook = Workbooks.Open(FileName)
End If
Set Z = Opnbook.Worksheets("入社_派遣社員")
Set H = Workbooks("管理表.xlsm.xlsm").Worksheets("追加職員データ入力")
Workbooks("管理表.xlsm.xlsm").Activate
Worksheets("追加職員データ入力").Select
If Range("C3").Value = "派遣" Then
Opnbook.Activate
Sheets("入社_派遣社員").Select
Range("A1").End(xlDown).Select
MsgBox "最終行は" & Range("A9").End(xlDown).Row & "です。"
結果 = MsgBox("入力行は" & Range("A9").End(xlDown).Row + 1 & "です。続けますか？", vbYesNo)
If 結果 = vbYes Then
n = Cells(Rows.Count, "A").End(xlUp).Row + 1
Range("A" & n).Select
ActiveWorkbook.Activate
Sheets("入社_派遣社員").Select
AAA:
Range("A" & n).Value = "ABC"
入力者 = InputBox("Inpurt YOUR Name", "入力者", "")
Range("B" & n).Value = 入力者
Range("C" & n).Value = "不要"
Range("I" & n).Value = H.Range("C4").Value
Range("J" & n).Value = "22" & H.Range("C5").Value
Range("K" & n).Value = H.Range("C6").Value
Range("L" & n).Value = H.Range("C7").Value
Range("M" & n).Value = H.Range("C8").Value
Range("N" & n).Value = H.Range("C9").Value
Range("O" & n).Value = H.Range("C10").Value
Range("P" & n).Value = H.Range("C11").Value
Range("Q" & n).Value = "日本"
Userform1.Show
'AAA、はここまでとしたい
Range("U" & n).Value = H.Range("C14").Value
Range("W" & n).Value = "JP02 NSC"
Range("X" & n).Value = "E-External"
Range("Y" & n).Value = "EC-Temp. (salaried)"
Range("Z" & n).Value = H.Range("C15").Value
コメント = InputBox("コメントがあれば、入力して下さい。", "コメント", "")
Range("AA" & n).Value = コメント
確認 = MsgBox("入力終了です。入力内容を確認しますか？", vbYesNo)
If 確認 = vbYes Then
Sheets("入社_派遣社員").Select
Else
'保存するか否かのダイアログ表示させたい。
'Application.DisplayAlerts = False ←これは、表示なしVersion
'Opnbook.Close
Workbooks("管理表_.xlsm.xlsm").Activate
H.Range("C3").Select
MsgBox "次は、XXを作成して下さい。"
End If
Else
MsgBox "必要項目に手入力して下さい。"
n = Cells(Rows.Count, "A").End(xlUp).Row + 1
Range("A" & n).Select
End If
ElseIf Range("C3").Value = "インターンシップ" Then
Opnbook.Activate
Sheets("入社_インターン").Select
Range("A1").End(xlDown).Select
MsgBox "最終行は" & Range("A9").End(xlDown).Row & "です。"
結果 = MsgBox("入力行は" & Range("A9").End(xlDown).Row + 1 & "です。続けますか？", vbYesNo)
If 結果 = vbYes Then
n = Cells(Rows.Count, "A").End(xlUp).Row + 1
Range("A" & n).Select
'Workbook ("管理表.xlsm")
ActiveWorkbook.Activate
Sheets("入社_インターン").Select
？ GoTo AAA ？
’この後がわからない。。。
End If
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
