| |
▼KOJIRO さん：
こんにちは
かみちゃんさんと同じく、要件がいまいち理解できていませんがもし、
・Ｗで始まる行がリスト内に２行ある。
・リストの左に１列追加し、Ｗではじまる行に対しては”ＡＡ”
・その他の行に対しては、最初のＷ以降が１からの連番、次のＷ以降が１０１からの連番。
ということであれば以下のいずれかをお試しください。
要件誤解していればスルーしてください。
Sub Sample1()
Dim flag2nd As Boolean
Dim seq As Long, i As Long
Application.ScreenUpdating = False
With Worksheets("Sheet1") '<== 実際のシート名に
.Columns("A:A").Insert shift:=xlToRight
For i = 1 To .Range("B" & .Rows.Count).End(xlUp).Row
If .Range("B" & i).Value = "W" And Not flag2nd Then
If seq > 0 Then
seq = 100
flag2nd = True
End If
.Range("A" & i).Value = "AA"
Else
seq = seq + 1
.Range("A" & i).Value = seq
End If
Next
End With
Application.ScreenUpdating = True
End Sub
Sub Sample2()
Dim y1 As Long, y2 As Long, yz As Long
Dim myC1 As Range, myC2 As Range
Application.ScreenUpdating = False
With Worksheets("Sheet1") '<== 実際のシート名に
yz = .Range("A" & .Rows.Count).End(xlUp).Row
Set myC1 = .Range("A1").Resize(yz).Find(What:="W", After:=.Range("A" & yz), _
LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, _
MatchByte:=False, SearchFormat:=False)
If Not myC1 Is Nothing Then
Set myC2 = .Range("A1").Resize(yz).FindNext(After:=myC1)
If myC1.Address = myC2.Address Then Set myC2 = Nothing
End If
If myC1 Is Nothing Or myC2 Is Nothing Then
MsgBox "W行は２行必要です"
Else
.Columns("A:A").Insert shift:=xlToRight
.Range("A" & myC1.Row).Value = "AA"
.Range("A" & myC1.Row).Offset(1).Value = 1
.Range("A" & myC1.Row).Offset(1).Resize(myC2.Row - myC1.Row - 1).DataSeries
.Range("A" & myC2.Row).Value = "AA"
.Range("A" & myC2.Row).Offset(1).Value = 101
.Range("A" & myC2.Row).Offset(1).Resize(yz - myC2.Row).DataSeries
End If
Set myC1 = Nothing
Set myC2 = Nothing
End With
Application.ScreenUpdating = True
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
