Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

3753 / 76735

←次へ　｜　前へ→


	【78611】重複文を避けたい　go to XXX

ふむふむ - 16/11/28(月) 18:08 -


	引用なし

	パスワード

皆様
お力をお貸し下さい。
以下が作成したモジュールです。

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

0 hits

▼

【78611】重複文を避けたい　go to XXX ふむふむ 16/11/28(月) 18:08