投稿/コメントを表示します。

発展編1 フォローメールセミナー
発展編1 フォローメールセミナー　第4回

受講生さんの投稿

(投稿ID: 4807)

12309 のコメント失礼いたしました。
一部修正します。
コメント投稿してみましたが、送信前の私のチェックが十分でないために
間違いに気づいて大変恥ずかしく思います。
削除頂けないでしょうか。

仕事でも、このような失敗があります。
チェックを怠ってミスすることや
自分の失言に自分でゲンナリすることもあります。
こうした自分自身も変わりたいです。
Option Explicit
 Sub yoshu01()
'[1]
    Dim shFm As Worksheet
    Dim lnFm As Long
    Dim lnFmMx As Long
    Set shFm = Worksheets("main")
    InFmMx = shFm.Range("C65536").End(xlUp).Row
    For lnFm = 2 To InFmMx
        If shFm.Range("B" & lnFm).Value <> shFm.Range("B" & lnFm + 1).Value Then 'ここで条件を追加しました
            Debug.Print shFm.Range("B" & lnFm).Value
        End If
    Next
    
 End Sub
Sub yoshu02()
'[2]
    Dim shFm As Worksheet
    Dim shTo As Worksheet
    Dim lnFm As Long
    Dim lnFmMx As Long
    Dim st As String
    Set shFm = Worksheets("main")
    lnFmMx = shFm.Range("C65536").End(xlUp).Row
    For lnFm = 2 To lnFmMx
        If shFm.Range("B" & lnFm).Value <> shFm.Range("B" & lnFm + 1).Value Then
            st = shFm.Range("B" & lnFm).Value
            Sheets("main1").Copy After:=Sheets(2)    'シート追加、シート名の指定しました
            Set shTo = ActiveSheet
            shTo.Name = st
        End If
    Next
    
End Sub
Sub yoshu03()
'[3]
    delete_renshu       'ここにシート削除のプロシージャを追加しました
    Dim shFm As Worksheet
    Dim shTo As Worksheet
    Dim lnFm As Long
    Dim lnFmMx As Long
    Dim st As String
    Set shFm = Worksheets("main")
    lnFmMx = shFm.Range("C65536").End(xlUp).Row
    For lnFm = 2 To lnFmMx
        If shFm.Range("B" & lnFm).Value <> shFm.Range("B" & lnFm + 1).Value Then
            st = shFm.Range("B" & lnFm).Value
            Sheets("main1").Copy After:=Sheets(2)
            Set shTo = ActiveSheet
            shTo.Name = st
        End If
    Next
    
End Sub
Sub delete_renshu()
    Dim sh As Worksheet
    Application.DisplayAlerts = False
    For Each sh In Worksheets
        If Left(sh.Name, 4) <> "main" Then
            sh.Delete
        End If
    Next
    Application.DisplayAlerts = True
End Sub

2020/07/28 10:50