【VBA】テキストデータ検索

わいえー@鹿目まどか同盟No.48 


'******特定履歴シート******

Sub DP_shukei()
    
'★★実際のシート列で要調整★★
    
    Dim xlLastRow As Long       'Excel自体の最終行
    Dim LastRow As Long         '最終行
 
    xlLastRow = Worksheets("特定履歴").Cells(Rows.Count, 1).Row  'Excelの最終行を取得
    
    LastRow = Worksheets("特定履歴").Cells(xlLastRow, 3).End(xlUp).Row   'C列の最終行を取得


'各DP結果の合計

    Range("E1") = WorksheetFunction.CountA(Worksheets("特定履歴").Range(Worksheets("特定履歴").Cells(3, 5), Worksheets("特定履歴").Cells(LastRow, 5)))
    Range("F1") = WorksheetFunction.CountA(Worksheets("特定履歴").Range(Worksheets("特定履歴").Cells(3, 6), Worksheets("特定履歴").Cells(LastRow, 6)))
    Range("G1") = WorksheetFunction.CountA(Worksheets("特定履歴").Range(Worksheets("特定履歴").Cells(3, 7), Worksheets("特定履歴").Cells(LastRow, 7)))
    Range("H1") = WorksheetFunction.CountA(Worksheets("特定履歴").Range(Worksheets("特定履歴").Cells(3, 8), Worksheets("特定履歴").Cells(LastRow, 8)))


End Sub






'******スキャンシート******

'測定状況表示ラベル新規作成(Label1　フォント太字30ポイント)


Sub CommandButton12_Click()

'測定開始ボタン

    If Range("D1") = "" Then
                
       
        MsgBox "MAGI IDを入力してください", vbExclamation, "★★★確認★★★"
        Range("D1").Select
        
        End


    End If


    Dim xlLastRow As Long       'Excel自体の最終行
    Dim LastRow As Long         '最終行
 
    xlLastRow = Worksheets("稼働時間測定").Cells(Rows.Count, 1).Row  'Excelの最終行を取得
    
    LastRow = Worksheets("稼働時間測定").Cells(xlLastRow, 1).End(xlUp).Row   'A列の最終行を取得

    Worksheets("稼働時間測定").Cells(LastRow + 1, 1) = Format(Now, "c")

    '★★★変更箇所★★★
    Worksheets("スキャン").Range("A1") = Format(Now, "c")


    Call tokutei_rireki_input(Worksheets("スキャン").Range("D1"), Worksheets("稼働時間測定").Cells(LastRow + 1, 1), "", "", 3)

    CommandButton12.Enabled = False
    CommandButton13.Enabled = True


    Label1.BackColor = &HFFFF00
    Label1.Caption = "【ピック】測定中"

    With Worksheets("スキャン")
      
      .Select
      'シートの保護
      .Protect
 
    End With
    
    '測定中断ボタン以外のボタンを操作不可(paste更新、他のボタンは要追加)
    CommandButton1.Enabled = False
    CommandButton2.Enabled = False
    CommandButton3.Enabled = False
    CommandButton4.Enabled = False
    CommandButton5.Enabled = False
    CommandButton6.Enabled = False
    CommandButton7.Enabled = False
    CommandButton8.Enabled = False
    CommandButton9.Enabled = False
    CommandButton10.Enabled = False
    CommandButton11.Enabled = False
    CommandButton14.Enabled = False

End Sub

Sub CommandButton13_Click()

'測定中断ボタン

    Dim xlLastRow As Long       'Excel自体の最終行
    Dim LastRow As Long         '最終行
 
    xlLastRow = Worksheets("稼働時間測定").Cells(Rows.Count, 2).Row  'Excelの最終行を取得
    
    LastRow = Worksheets("稼働時間測定").Cells(xlLastRow, 2).End(xlUp).Row   'B列の最終行を取得
    
    Worksheets("稼働時間測定").Cells(LastRow + 1, 2) = Format(Now, "c")


    CommandButton12.Enabled = True
    CommandButton13.Enabled = False

    Label1.BackColor = &H8080FF
    Label1.Caption = "【ピック】測定中断"

    With Worksheets("スキャン")
      
      .Select
      'シートの保護解除
      .Unprotect
      
    End With
 
    '測定中断ボタン以外のボタンを操作可能にもどす(paste更新、他のボタンは要追加)
    CommandButton1.Enabled = True
    CommandButton2.Enabled = True
    CommandButton3.Enabled = True
    CommandButton4.Enabled = True
    CommandButton5.Enabled = True
    CommandButton6.Enabled = True
    CommandButton7.Enabled = True
    CommandButton8.Enabled = True
    CommandButton9.Enabled = True
    CommandButton10.Enabled = True
    CommandButton11.Enabled = True
    CommandButton14.Enabled = True
 
End Sub

Sub CommandButton14_Click()

'IDクリアボタン

    Range("D1") = ""
    Range("D1").Select
        
    ActiveWorkbook.Save

    Range("B3").Select

End Sub

'セルC2(MAGIID)、名前表示セルは要調整

Private Sub CommandButton2_Click()

'2回目検品ボタン

    If Range("D1") = "" Then
        
        MsgBox "MAGI IDを入力してください", vbExclamation, "★★★確認★★★"
        Range("D1").Select
        
        End

        
    End If


    Dim xlLastRow As Long       'Excel自体の最終行
    Dim LastRow As Long         '最終行
 
    xlLastRow = Worksheets("稼働時間測定").Cells(Rows.Count, 1).Row  'Excelの最終行を取得
    
    LastRow = Worksheets("稼働時間測定").Cells(xlLastRow, 1).End(xlUp).Row   'A列の最終行を取得

    Worksheets("稼働時間測定").Cells(LastRow + 1, 1) = Format(Now, "c")

    '★★★変更箇所★★★
    Worksheets("スキャン").Range("A1") = Format(Now, "c")


    
    UserForm2.Label1.Caption = "★★★2回目検品登録★★★" & vbCr & vbCr & "検品者MAGIID:" & Range("D1").Value & vbCr & "検品者:" & Range("D2").Value
    UserForm2.Label2.Caption = "◆◆◆直前登録情報◆◆◆" & vbCr & "グローバルID: "
    UserForm2.BackColor = RGB(0, 180, 255)
    UserForm2.TextBox1.SetFocus
    
    UserForm2.Show

End Sub



Private Sub CommandButton1_Click()

'部材検索ボタン１

    '商品コードからミスミページで検索
    Call misumi_search(Range("B10").Value)

    Range("AY1").Value = 1
    Range("AZ1").Value = 10

    '★★★変更箇所★★★
    Worksheets("スキャン").Range("A1") = Format(Now, "c")
        
    Worksheets("DP結果入力").Select


End Sub



Private Sub CommandButton3_Click()

'部材検索ボタン２

    '商品コードからミスミページで検索
    Call misumi_search(Range("B11").Value)

    Range("AY1").Value = 1
    Range("AZ1").Value = 11

    '★★★変更箇所★★★
    Worksheets("スキャン").Range("A1") = Format(Now, "c")
        
    Worksheets("DP結果入力").Select


End Sub

Private Sub CommandButton4_Click()

'部材検索ボタン３

    '商品コードからミスミページで検索
    Call misumi_search(Range("B12").Value)

    Range("AY1").Value = 1
    Range("AZ1").Value = 12


    '★★★変更箇所★★★
    Worksheets("スキャン").Range("A1") = Format(Now, "c")
        
    Worksheets("DP結果入力").Select


End Sub

Private Sub CommandButton5_Click()

'部材検索ボタン４

    '商品コードからミスミページで検索
    Call misumi_search(Range("B13").Value)

    Range("AY1").Value = 1
    Range("AZ1").Value = 13

    '★★★変更箇所★★★
    Worksheets("スキャン").Range("A1") = Format(Now, "c")
        
    Worksheets("DP結果入力").Select


End Sub

Private Sub CommandButton6_Click()

'部材検索ボタン５

    '商品コードからミスミページで検索
    Call misumi_search(Range("B14").Value)

    Range("AY1").Value = 1
    Range("AZ1").Value = 14

    '★★★変更箇所★★★
    Worksheets("スキャン").Range("A1") = Format(Now, "c")
        
    Worksheets("DP結果入力").Select


End Sub
Private Sub CommandButton7_Click()

'部材検索ボタン６

    '商品コードからミスミページで検索
    Call misumi_search(Range("B15").Value)

    Range("AY1").Value = 1
    Range("AZ1").Value = 15

    '★★★変更箇所★★★
    Worksheets("スキャン").Range("A1") = Format(Now, "c")
        
    Worksheets("DP結果入力").Select


End Sub

Private Sub CommandButton8_Click()

'部材検索ボタン７

    '商品コードからミスミページで検索
    Call misumi_search(Range("B16").Value)

    Range("AY1").Value = 1
    Range("AZ1").Value = 16

    '★★★変更箇所★★★
    Worksheets("スキャン").Range("A1") = Format(Now, "c")
        
    Worksheets("DP結果入力").Select


End Sub

Private Sub CommandButton9_Click()

'部材検索ボタン８

    '商品コードからミスミページで検索
    Call misumi_search(Range("B17").Value)

    Range("AY1").Value = 1
    Range("AZ1").Value = 17

    '★★★変更箇所★★★
    Worksheets("スキャン").Range("A1") = Format(Now, "c")
        
    Worksheets("DP結果入力").Select


End Sub


Private Sub CommandButton10_Click()

'部材検索ボタン９

    '商品コードからミスミページで検索
    Call misumi_search(Range("B18").Value)


    Range("AY1").Value = 1
    Range("AZ1").Value = 18

    '★★★変更箇所★★★
    Worksheets("スキャン").Range("A1") = Format(Now, "c")
        
    Worksheets("DP結果入力").Select



End Sub

Private Sub CommandButton11_Click()

'部材検索ボタン１０

    '商品コードからミスミページで検索
    Call misumi_search(Range("B19").Value)

    Range("AY1").Value = 1
    Range("AZ1").Value = 19

    '★★★変更箇所★★★
    Worksheets("スキャン").Range("A1") = Format(Now, "c")
        
    Worksheets("DP結果入力").Select


End Sub

Sub Worksheet_Change(ByVal Target As Range)

'バーコードスキャンされた時の処理

'★セルB3に入力規則を設定(整数のみ、10000～99999)
   
    If Range("D1") = "" Then
        
        MsgBox "MAGI IDを入力してください", vbExclamation, "★★★確認★★★"
        Range("D1").Select
        
      
        End
   
    End If


'セル値が変更されたときに処理を実行
    If Not Intersect(Target, Range("B3")) Is Nothing Then
    
        Range("AY1").Value = 1
               
    
        If Range("B3") <> "" Then
                    
            'スキャンしたグローバルIDで検索した商品コードをセルに表示する
            Call serch_shoin_code
                    
                    
            '部材判定
            Dim n As Long
            n = WorksheetFunction.CountIf(Range("B10:B19"), "<>")
                    
            If n > 0 Then
            
                '部材のメッセージウィンドウを出す
                UserForm1.Show
                
                End
                               
            Else
                
                '商品コードからミスミページで検索
                Call misumi_search(Range("B2").Value)
                
                '★★★変更箇所★★★
                Worksheets("スキャン").Range("A1") = Format(Now, "c")
        
                Worksheets("DP結果入力").Select
        
            End If
        
        
        End If
         
    End If

End Sub


Sub tokutei_rireki_input(ByVal MAGI_ID, ByVal now_time, ByVal global_ID, ByVal shohin_code, ByVal DP_kekka)
 
'★★実際のシート列で要調整★★
 
    Dim xlLastRow As Long       'Excel自体の最終行
    Dim LastRow As Long         '最終行
 
    xlLastRow = Worksheets("特定履歴").Cells(Rows.Count, 1).Row  'Excelの最終行を取得
    
    LastRow = Worksheets("特定履歴").Cells(xlLastRow, 2).End(xlUp).Row   'B列の最終行を取得
    
    Worksheets("特定履歴").Cells(LastRow + 1, 1) = MAGI_ID
    Worksheets("特定履歴").Cells(LastRow + 1, 2) = now_time
    Worksheets("特定履歴").Cells(LastRow + 1, 3) = global_ID
    Worksheets("特定履歴").Cells(LastRow + 1, 4) = shohin_code


    Select Case DP_kekka

        Case 1
        Worksheets("特定履歴").Cells(LastRow + 1, 5) = "DP OK"
        
        Case 2
        Worksheets("特定履歴").Cells(LastRow + 1, 6) = "一部DP OK"
        
        Case 3
        Worksheets("特定履歴").Cells(LastRow + 1, 7) = "ピック"
        
        Case 4
        Worksheets("特定履歴").Cells(LastRow + 1, 8) = "2回目　DP"
        
        Case 5
        Worksheets("特定履歴").Cells(LastRow + 1, 9) = "2回目"
        
        Case 6
        Worksheets("特定履歴").Cells(LastRow + 1, 10) = "1回目手数え"
        
        Case Else
        Worksheets("DP結果入力").Select
        
    End Select
    
End Sub


Sub serch_shoin_code()

'スキャンしたグローバスIDで商品コードを検索、セルに表示する

'★pasteシートの検索セルの位置は要調整
        
    On Error Resume Next

    Dim ws As Worksheet
    Dim key As String
    Dim find_count As String

    Dim i As Integer

    '子ラベルの商品コードをセルから消す
    For i = 0 To 9
        
        Worksheets("スキャン").Cells(10 + i, 2) = ""
    
    Next i


    Dim xlLastRow As Long       'Excel自体の最終行
    Dim LastRow As Long         '最終行
     
    Set ws = ThisWorkbook.Worksheets("paste")
 
    xlLastRow = ws.Cells(Rows.Count, 1).Row  'Excelの最終行を取得
    
    LastRow = ws.Cells(xlLastRow, 1).End(xlUp).Row   'A列の最終行を取得


    key = Worksheets("スキャン").Cells(3, 2).Value
    
    
    Set rng = ws.Range(ws.Cells(1, 1), ws.Cells(LastRow, 1)).Find(What:=key, LookAt:=xlWhole, SearchOrder:=xlByRows)
    
    'スキャンした商品コードと検索一致するpasteの行番号
    'rng.Row
    
    'スキャンした商品コードと検索一致するセルの個数
    find_count = WorksheetFunction.CountIf(ws.Range(ws.Cells(1, 1), ws.Cells(LastRow, 1)), key)
    
    
    '商品コード(部材なら親ラベル)
    Worksheets("スキャン").Cells(2, 2) = ws.Cells(rng.Row, 2).Value
    
    '部材子ラベルの商品コード
    For i = 1 To find_count - 1
        
        Worksheets("スキャン").Cells(9 + i, 2) = ws.Cells(rng.Row + i, 2).Value
    
    Next i
    

End Sub




Sub misumi_search(shohin_code As String)

    Dim strURL

    strURL = "https://jp.misumi-ec.com/vona2/result/?Keyword=" + shohin_code + "&isReSearch=0"
    CreateObject("WScript.Shell").Run "chrome.exe -url " & strURL


End Sub


Sub Google_search(shohin_code As String)

    Dim strURL

    strURL = "https://www.google.co.jp/search?q=" + shohin_code + "+misumi&tbm=isch&hl=ja&lr=lang_ja&num=20&safe=high&filter=0&pws=0"
    CreateObject("WScript.Shell").Run "chrome.exe -url " & strURL


End Sub

'******DB結果入力シート******

Private Sub CommandButton1_Click()
'1回目完結ボタン

    'スキャン、部材ボタンが押されたかの判定
    If Worksheets("スキャン").Range("AY1").Value <> 1 Then

        
        MsgBox "スキャン画面に戻ります", vbExclamation, "スキャン画面での操作が必要です"
        
        Worksheets("スキャン").Select
        Worksheets("スキャン").Range("B3").Activate
    
        End

    End If


    Worksheets("スキャン").Range("AY1").Value = 0


    Dim xlLastRow As Long       'Excel自体の最終行
    Dim LastRow As Long         '最終行
 
    xlLastRow = Worksheets("稼働時間測定").Cells(Rows.Count, 2).Row  'Excelの最終行を取得
    
    LastRow = Worksheets("稼働時間測定").Cells(xlLastRow, 2).End(xlUp).Row   'B列の最終行を取得
    
    
        '部材検索ボタンが押されたかの判定
        If Worksheets("スキャン").Range("AZ1").Value > 0 Then
            
            '★★★変更箇所★★★
            Call Worksheets("スキャン").tokutei_rireki_input(Worksheets("スキャン").Range("D1"), Worksheets("スキャン").Range("A1"), Worksheets("スキャン").Range("B3"), Worksheets("スキャン").Cells(Worksheets("スキャン").Range("AZ1").Value, 2), 1)

        Else

            '★★★変更箇所★★★
            Call Worksheets("スキャン").tokutei_rireki_input(Worksheets("スキャン").Range("D1"), Worksheets("スキャン").Range("A1"), Worksheets("スキャン").Range("B3"), Worksheets("スキャン").Range("B2"), 1)

        End If
        
            'Call Worksheets("特定履歴").DP_shukei
            
            '★★★変更箇所★★★
            Worksheets("稼働時間測定").Cells(LastRow + 1, 1) = Worksheets("スキャン").Range("A1")
            Worksheets("稼働時間測定").Cells(LastRow + 1, 2) = Format(Now, "c")
       
            Worksheets("スキャン").Select
            Worksheets("スキャン").Range("B3").Activate
    

End Sub

Private Sub CommandButton2_Click()

'一部DBOKボタン

    'スキャン、部材ボタンが押されたかの判定
    If Worksheets("スキャン").Range("AY1").Value <> 1 Then

        MsgBox "スキャン画面に戻ります", vbExclamation, "スキャン画面での操作が必要です"

        Worksheets("スキャン").Select
        Worksheets("スキャン").Range("B3").Activate
    
        End

    End If


    Worksheets("スキャン").Range("AY1").Value = 0


    Dim xlLastRow As Long       'Excel自体の最終行
    Dim LastRow As Long         '最終行
 
    xlLastRow = Worksheets("稼働時間測定").Cells(Rows.Count, 2).Row  'Excelの最終行を取得
    
    LastRow = Worksheets("稼働時間測定").Cells(xlLastRow, 2).End(xlUp).Row   'B列の最終行を取得

    
    '部材検索ボタンが押されたかの判定
    If Worksheets("スキャン").Range("AZ1").Value > 0 Then
        
        '★★★変更箇所★★★
        Call Worksheets("スキャン").tokutei_rireki_input(Worksheets("スキャン").Range("D1"), Worksheets("スキャン").Range("A1"), Worksheets("スキャン").Range("B3"), Worksheets("スキャン").Cells(Worksheets("スキャン").Range("AZ1").Value, 2), 2)

    Else

        '★★★変更箇所★★★
        Call Worksheets("スキャン").tokutei_rireki_input(Worksheets("スキャン").Range("D1"), Worksheets("スキャン").Range("A1"), Worksheets("スキャン").Range("B3"), Worksheets("スキャン").Range("B2"), 2)

    End If
    
        '★★★変更箇所★★★
        Worksheets("稼働時間測定").Cells(LastRow + 1, 1) = Worksheets("スキャン").Range("A1")
        Worksheets("稼働時間測定").Cells(LastRow + 1, 2) = Format(Now, "c")
        
        'Call Worksheets("特定履歴").DP_shukei
    
        Worksheets("スキャン").Select
        Worksheets("スキャン").Range("B3").Activate


End Sub

Private Sub CommandButton5_Click()
'Google検索ボタン


    'スキャン、部材ボタンが押されたかの判定
    If Worksheets("スキャン").Range("AY1").Value <> 1 Then

        MsgBox "スキャン画面に戻ります", vbExclamation, "スキャン画面での操作が必要です"

        Worksheets("スキャン").Select
        Worksheets("スキャン").Range("B3").Activate
    
        End

    End If


    '商品コードからGoogleで画像検索
    Call Worksheets("スキャン").Google_search(Worksheets("スキャン").Cells(Worksheets("スキャン").Range("AZ1"), 2).Value)

    


End Sub

Private Sub CommandButton6_Click()

'スキャン画面に戻るボタン


            '★★★変更箇所★★★
            '稼働時間測定の時間記録処理は削除

    'スキャン、部材ボタンが押されたかの判定
    If Worksheets("スキャン").Range("AY1").Value <> 1 Then

        
        Worksheets("スキャン").Select
        Worksheets("スキャン").Range("B3").Activate
    
        End

    End If
    
    Worksheets("スキャン").Range("AY1").Value = 0
    
    '★★★変更箇所★★★
    '選択ボタンのユーザフォームを表示する
    UserForm3.Show
  

End Sub

'******2回目検品(新規ユーザフォーム)******

'セルC2(MAGIID)、名前表示セルは要調整


Dim scan_count As Integer


Sub CommandButton1_Click()

'作業終了ボタン

     Dim xlLastRow As Long       'Excel自体の最終行
     Dim LastRow As Long         '最終行



    If OptionButton1.Value = True And scan_count < 1 Then
 
        xlLastRow = Worksheets("稼働時間測定").Cells(Rows.Count, 1).Row  'Excelの最終行を取得
    
        LastRow = Worksheets("稼働時間測定").Cells(xlLastRow, 1).End(xlUp).Row   'B列の最終行を取得
   
        Worksheets("稼働時間測定").Cells(LastRow, 1) = ""


    End If

    If OptionButton1.Value = True And scan_count > 0 Then

        xlLastRow = Worksheets("稼働時間測定").Cells(Rows.Count, 2).Row  'Excelの最終行を取得
    
        LastRow = Worksheets("稼働時間測定").Cells(xlLastRow, 2).End(xlUp).Row   'B列の最終行を取得
   
        Worksheets("稼働時間測定").Cells(LastRow + 1, 2) = Format(Now, "c")


    End If


    Unload UserForm2

End Sub

Sub OptionButton1_click()

    'チェックボタン　DPする(デフォルトでチェックON プロパティーのvalueをTrueにする)
    
    
    UserForm2.BackColor = RGB(0, 180, 255)
    TextBox1.SetFocus
    
    Dim xlLastRow As Long       'Excel自体の最終行
    Dim LastRow As Long         '最終行
 
    xlLastRow = Worksheets("稼働時間測定").Cells(Rows.Count, 1).Row  'Excelの最終行を取得
    
    LastRow = Worksheets("稼働時間測定").Cells(xlLastRow, 1).End(xlUp).Row   'A列の最終行を取得

    Worksheets("稼働時間測定").Cells(LastRow + 1, 1) = Format(Now, "c")
    
    '★★★変更箇所★★★
    Worksheets("スキャン").Range("A1") = Format(Now, "c")
    

End Sub


Sub OptionButton2_click()

    'チェックボタン　DPしない
    
    UserForm2.BackColor = RGB(255, 140, 0)
    TextBox1.SetFocus
    
    Dim xlLastRow As Long       'Excel自体の最終行
    Dim LastRow As Long         '最終行
  
    xlLastRow = Worksheets("稼働時間測定").Cells(Rows.Count, 1).Row  'Excelの最終行を取得
    LastRow = Worksheets("稼働時間測定").Cells(xlLastRow, 1).End(xlUp).Row   'A列の最終行を取得
 
 
    '検品していない場合
    If scan_count < 1 Then
 
        Worksheets("稼働時間測定").Cells(LastRow, 1) = ""
  
    '1回以上検品している場合
    Else
    
        Worksheets("稼働時間測定").Cells(LastRow, 2) = Format(Now, "c")
    
    End If
    

End Sub



Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
   
   
    If TextBox1.Value = "" Then
    
        Cancel = False
        
        TextBox1.SetFocus
  
    Else
        
        Cancel = True
        
        If OptionButton1.Value = True Then
            
            Dim ans As Variant
            
            ans = jyufuku_ID_kensaku(TextBox1.Value)
            
            If ans = 0 Then
            
                Call Worksheets("スキャン").tokutei_rireki_input(Worksheets("スキャン").Range("D1"), Format(Now, "yyyy/mm/dd hh:mm:ss"), TextBox1.Value, "", 4)
        
                '★★★追加　直前登録情報をユーザフォームlabel2に表示する
                Label2.Caption = "◆◆◆直前登録情報◆◆◆" & vbCr & "グローバルID: " & TextBox1.Value
            
            Else
        
                '★★★追加　直前登録情報をユーザフォームlabel2に表示する
                Label2.Caption = "◆◆◆直前登録情報◆◆◆" & vbCr & "グローバルID: すでに登録済みです"
        
            End If
        
        
        Else
        
            ans = jyufuku_ID_kensaku(TextBox1.Value)
           
            If ans = 0 Then
            
                Call Worksheets("スキャン").tokutei_rireki_input(Worksheets("スキャン").Range("D1"), Format(Now, "yyyy/mm/dd hh:mm:ss"), TextBox1.Value, "", 5)
        
                '★★★追加　直前登録情報をユーザフォームlabel2に表示する
                Label2.Caption = "◆◆◆直前登録情報◆◆◆" & vbCr & "グローバルID: " & TextBox1.Value
            
            Else
        
                '★★★追加　直前登録情報をユーザフォームlabel2に表示する
                Label2.Caption = "◆◆◆直前登録情報◆◆◆" & vbCr & "グローバルID: すでに登録済みです"
        
            End If
        
        End If
        
            If OptionButton1.Value = True Then
        
                scan_count = scan_count + 1
                                
                
            Else
            
                scan_count = 0
                    
            End If
        
        TextBox1.Value = ""
    
    End If
    
    

End Sub


Sub UserForm_Activate()

    scan_count = 0

End Sub


Function jyufuku_ID_kensaku(global_ID As Variant)

'すでに登録されているグローバルIDを検索する

    On Error Resume Next
    

    Dim xlLastRow As Long       'Excel自体の最終行
    Dim LastRow As Long         '最終行
  
    xlLastRow = Worksheets("特定履歴").Cells(Rows.Count, 1).Row  'Excelの最終行を取得
    LastRow = Worksheets("特定履歴").Cells(xlLastRow, 1).End(xlUp).Row   'A列の最終行を取得

    Dim find_row As Long
    Dim id_row As Long
    
    find_row = WorksheetFunction.Match(CLng(Date), Worksheets("特定履歴").Range("B:B"), 1)

       
    find_id = WorksheetFunction.Match(global_ID, Worksheets("特定履歴").Range(Worksheets("特定履歴").Cells(find_row + 1, 3), Worksheets("特定履歴").Cells(LastRow, 3)), 0)

    
    jyufuku_ID_kensaku = find_id
        
    
    
End Function



'++++選択ボタンユーザフォーム（スキャン戻るボタンを押した時に表示）++++++


Private Sub CommandButton1_Click()

'1回目手数えボタン
    
    
                '★★★変更箇所★★★
            '稼働時間測定の時間記録処理は削除
    
    
     '部材検索ボタンが押されたかの判定
    If Worksheets("スキャン").Range("AZ1").Value > 0 Then
        
        '★★★変更箇所★★★
        Call Worksheets("スキャン").tokutei_rireki_input(Worksheets("スキャン").Range("D1"), Worksheets("スキャン").Range("A1"), Worksheets("スキャン").Range("B3"), Worksheets("スキャン").Cells(Worksheets("スキャン").Range("AZ1").Value, 2), 6)

    Else

        '★★★変更箇所★★★
        Call Worksheets("スキャン").tokutei_rireki_input(Worksheets("スキャン").Range("D1"), Worksheets("スキャン").Range("A1"), Worksheets("スキャン").Range("B3"), Worksheets("スキャン").Range("B2"), 6)

    End If
    

        
    Worksheets("スキャン").Select
    Worksheets("スキャン").Range("B3").Activate

    Unload UserForm3


End Sub

Private Sub CommandButton2_Click()

    
'作業中断等ボタン


            '★★★変更箇所★★★
            '稼働時間測定の時間記録処理は削除

    Worksheets("スキャン").Select
    Worksheets("スキャン").Range("B3").Activate

    Unload UserForm3


End Sub
プロパティ　backstyle は0を選択する


この記事が気に入ったらサポートをしてみませんか？