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
小川慶一さんのコメント
(コメントID: 6736)
受講生 さん:
おはようございます。
くり返しの構文には、 for next, for each, do loop があります。 それぞれ別の特徴があります。 for next がいちばん概念を理解しやすいし取り扱いも簡単なので、講座では基礎編で for next、発展編1であとの2つ、という順序でノウハウをお伝えしています。
受講生さんの投稿
(投稿ID: 4807)
一部修正します。
コメント投稿してみましたが、送信前の私のチェックが十分でないために
間違いに気づいて大変恥ずかしく思います。
削除頂けないでしょうか。
仕事でも、このような失敗があります。
チェックを怠ってミスすることや
自分の失言に自分でゲンナリすることもあります。
こうした自分自身も変わりたいです。
小川慶一さんのコメント
(コメントID: 6736)
おはようございます。
くり返しの構文には、 for next, for each, do loop があります。
それぞれ別の特徴があります。 for next がいちばん概念を理解しやすいし取り扱いも簡単なので、講座では基礎編で for next、発展編1であとの2つ、という順序でノウハウをお伝えしています。