Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

15566 / 76738

←次へ　｜　前へ→


	【66648】Re:変数を追加したい

UO3 - 10/9/21(火) 11:52 -


	引用なし

	パスワード

▼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

0 hits

▼

【66640】変数を追加したい KOJIRO 10/9/18(土) 11:57