[[20170323160412]]　『選択範囲について』（komame）　ページの最後に飛ぶ

『選択範囲について』（komame）

いつも拝見させていただいております。

vbaを勉強しているのですが、

A列　B列　
空白　　
ここ　 4
空白　
空白　
空白　
空白　
ここ　 2
空白　
空白　
ここ　
空白　　

このようなA列に「ここ」と入力した値のセルがあり、上から順に2行目ここ～7行目ここ　まで範囲取得して空白セルの数を取得してB列に数を記入、次は7行目ここ～10行目ここ　まで範囲選択をして・・・と最終行まで繰り返したいのですが、色々サイトを見ているのですが、よくわからないのでどなたか教えていただけないでしょうか。

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

 確認です。

 A列になにかしら値があるということでいいのですか？
 それとも　『ここ』限定ですか？

 つまり　『ここ』ではなく『こちら』だとすると、それは空白扱いですか？

 それと、最後の『ここ』、この下はすべて空白ですけど、そこには、最終行までの行数を入れたいのでしょうか？
 それとも、最後の　『ここ』に対しては数字は不要？

 追加で。

 『ここ』が連続しているケースもありますか？（つまり、間の空白行数は 0 ）

（β） 2017/03/23(木) 16:21

（β）さま

お返事ありがとうございます。
「ここ」限定です。「こちら」だと空白として「ここ」から「ここ」までを選択したいです。また、最後の「ここ」については数字は不要です。「ここ」が連続しているケースはないです。

（komame） 2017/03/23(木) 16:32

 とりあえず、処理効率無視のコードです。
 何をどう判定しているのか、わかりやすいのではと思いまして。

 Sub Sample1()
    Dim f As Long
    Dim i As Long

    Columns("B").ClearContents

    For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
        If Cells(i, "A").Value = "ここ" Then
            If f = 0 Then
                f = i
            Else
                Cells(f, "B").Value = i - f - 1
                f = i
            End If
        End If
    Next

 End Sub

（β） 2017/03/23(木) 17:04

 もう一例あげておきます。

 A列には True や False といった値がないこと、かならず 1つ以上の『ここ』があること　という縛りですが。

 Sub Sample2()
    Dim sv As Variant
    Dim r As Range
    Dim f As Range
    Dim c As Range

    With Range("A1", Range("A" & Rows.Count).End(xlUp))
        ReDim v(1 To .Rows.Count, 1 To 1)
        sv = .Formula
        .Cells.Replace "ここ", True, xlWhole
        Set r = .SpecialCells(xlCellTypeConstants, xlLogical)
        For Each c In r
            If Not f Is Nothing Then v(f.Row, 1) = c.Row - f.Row - 1
            Set f = c
        Next
        .Offset(, 1).Value = v
        .Value = sv
    End With

 End Sub

（β） 2017/03/23(木) 17:15

（β）さま

コードありがとうございます。まだまだ勉強中なので、頂いたコードを理解して自分で記述できるよう頑張ります。

ありがとうございます。
（komame） 2017/03/23(木) 17:19

 反則技。

 Sub a()
    Dim CNT As Long

    CNT = Range("A" & Rows.Count).End(xlUp).Row
    Worksheets("Sheet1").Range(Cells(1, "B"), Cells(CNT - 1, "B")).Formula = _
    "=IFERROR(IF(A1="""","""",MATCH(""a"",A2:A$" & CNT & ",0)-1),"""")"
 End Sub

（ねむねむ） 2017/03/23(木) 17:23

 ちょい修正。

 Sub a()
    Dim CNT As Long

    CNT = Range("A" & Rows.Count).End(xlUp).Row
    Range("B1:B" & CNT - 1).Formula = _
    "=IFERROR(IF(A1="""","""",MATCH(""a"",A2:A$" & CNT & ",0)-1),"""")"
    Range("B1:B" & CNT - 1).Value = Range("B1:B" & CNT - 1).Value
 End Sub

（ねむねむ） 2017/03/23(木) 17:31

A1セルが空白でないとまずいですが、
空白セルを取得するなら、ジャンプ機能（SpecialCells）が便利です。

Sub test()

    Dim rngTop As Range
    Dim rngBottom As Range
    Dim rngTarget As Range
    Dim c As Range

    Set rngTop = Cells(1, "A").End(xlDown)
    Set rngBottom = Cells(Rows.Count, "A").End(xlUp)
    On Error Resume Next
    Set rngTarget = Application.Range(rngTop, rngBottom).SpecialCells(xlCellTypeBlanks)
    On Error GoTo 0

    If rngTarget Is Nothing Then Exit Sub

    For Each c In rngTarget.Areas
        c(1).Offset(-1, 1).Value = c.Cells.Count
    Next
End Sub

（まっつわん） 2017/03/23(木) 17:38

（ねむねむ）さま
（まっつわん）さま
お返事ありがとうございます。頂きました貴重なコードを一つずつ理解して頑張ります。

（komame） 2017/03/23(木) 18:28

 すまない、
 MATCH(""a"" 
 の""a""は""ここ""としてくれ。

（ねむねむ） 2017/03/23(木) 20:40

コメント返信：

[ 一覧(最新更新順) ]

[[20170323160412]] 『選択範囲について』（komame） ページの最後に飛ぶ

[[20170323160412]]　『選択範囲について』（komame）　ページの最後に飛ぶ