|
▼SS様
先ほどはご助言ありがとうございます。
あれから一度試してみまして、SS様のものを参考(ほとんど真似てますが・・・)にさせていただき、こちらの条件に合うように作ってみました(内容は引き続き超初心者様のものを使用させて頂いております!)
下記のものを実行したところ、デバックで追って見るとちゃんと機能しているのですが
全作業終了後、他のシートを見てみると並び替えも移動もされていない状態でした・・・
ただ反映されてないだけなのかな?と更新もしてみましたが 中身は変化なく、どうやらマクロが反映されていないようです・・・
度々の質問、申し訳ありませんが
ここが違う!というような場所があれば是非ご指摘をお願いたします!
Sub test()
Dim mySheet As Worksheet
For Each mySheet In Worksheets
Select Case mySheet.Name
Case 1 To 9, 10 To 19, 20 To 29
Call sub_sampleple(mySheet)
Case Else
MsgBox "処理を飛ばします"
End Select
Next mySheet
End Sub
Sub sub_sampleple(MS As Worksheet)
Dim myB2 As Integer
Dim myMOVE As Boolean
Dim myRow As Long
Dim myRowMax As Long
Dim myCnt As Long
'第一条件の判定
Select Case MS.Range("B2").Value
Case "あ", "い", "う"
myB2 = 1
Case "え", "お"
myB2 = 2
End Select
myRow = 3 'B3から
myRowMax = 20 'B20までをチェック
Do
'第二条件の判定
Select Case MS.Cells(myRow, 2).Value
Case 1, 11, 20
myMOVE = (myB2 = 1)
Case 50, 100
myMOVE = (myB2 = 2)
Case Else
myMOVE = False
End Select
'移動処理
If myMOVE Then
MS.Rows(myRow).Cut
MS.Rows(30 + myCnt).Insert Shift:=xlDown '30行目に挿入
MS.Rows(30 - 1).Insert Shift:=xlDown
myCnt = myCnt + 1
myRowMax = myRowMax - 1
Else
myRow = myRow + 1
End If
Loop Until myRow > myRowMax
End Sub
|
|