2つの交互のテキストを含むセルの行番号を見つける

Question

これらの2つの交互のテキストに対してG列を検索し、その列番号をB2からB列まで出力したいと考えています。それは現在のみ最初の「チャージ」を見つけ、出力として「$ G $ 1」になりますが、それは他のすべての値を見つけることが続行されません

Row  
1 Charge 
2  7 
3  7 
4 Discharge 
5  2 
6 Charge 
7  9 

：

データは次のように見えます。あなたはカンマで区切られたB2二列にしたいという意味ならば、私はまた、代わりに「$ G $ 1」だけ「1」に出力

Sub RowFinder() 

    Dim Found As Range 
    Dim SearchVal(1 To 2) As String 

    SearchVal(1) = "Charge" 
    SearchVal(2) = "Discharge" 

    Set Found = ActiveWorkbook.Sheets("General 
    Text").Columns("G").Find(what:=SearchVal(), _ 
    LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext) 

    If Not Found Is Nothing Then 
     ActiveWorkbook.ActiveSheet.Range("B2").Value = Found.Row 
    End If 

End Sub 

Answer 1

のためのように、これは行う必要があります：

"B2" で

Sub RowFinder() 
    Range("B2").value = Join(Application.Match _ 
     (Array("Charge", "Discharge"), Sheets("General Text").Columns("G"), 0), ",") 
End Sub 

出力：

： 1,4

それともB2とC2でそれらをしたい場合10

そしてB2とB3でそれらを持っている：

Range("B2:B3").value = Application.Transpose(Application.Match _ 
    (Array("Charge", "Discharge"), Sheets("General Text").Columns("G"), 0)) 

最後に、あなたがそれらすべてを見つけたいが、連続して：

Sub RowFinder() 
    Dim rng As Range, j As Long, lastCell As Range, ar 
    ar = Array("Charge", "Discharge") 
    j = 2 
    With Sheets("General Text") 
     Set lastCell = .Cells(.Rows.Count, "G").End(xlUp) 
     Set rng = .Range("G1", lastCell) 
     On Error GoTo Finished 
     Do 
      .Cells(j, "B").value = rng.row - 1 + Application.Match(ar(j Mod 2), rng, 0) 
      Set rng = .Range("G" & .Cells(j, "B").value, lastCell) 
      j = j + 1 
     Loop 
    End With 
Finished: 
End Sub 

Answer 2

別の可能性、したがってループを避け、Autofilter()を使用しました：

Sub RowFinder() 
    Dim founds As Range 
    With Worksheets("General Text") '<--| reference your worksheet 
     With .Range("G1", .Cells(.Rows.count, "G").End(xlUp)) '<--| reference its column G cells from row 1 (header) down to last not empty one 
      .AutoFilter Field:=1, Criteria1:=Array("Charge", "Discharge"), Operator:=xlFilterValues '<--| filter cells with "Charge" and "Discharge" 
      If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then Set founds = .Resize(.Rows.count - IIf(InStr("ChargeDischarge", .Cells(1)) > 0, 0, 1)).Offset(IIf(InStr("ChargeDischarge", .Cells(1)) > 0, 0, 1)).SpecialCells(xlCellTypeVisible) 
     End With 
     .AutoFilterMode = False 
     If Not founds Is Nothing Then .Range("B2").Resize(founds.count) = Application.Transpose(Split(Replace(founds.Address(False, False), "G", ""), ",")) 
    End With 
End Sub 

ここで、列Gが行1に「ヘッダ」 、あなたが変更することができます。

If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then Set founds = .Resize(.Rows.count - IIf(InStr("ChargeDischarge", .Cells(1)) > 0, 0, 1)).Offset(IIf(InStr("ChargeDischarge", .Cells(1)) > 0, 0, 1)).SpecialCells(xlCellTypeVisible) 

に： `= Found.Row`

If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then Set founds = .Resize(.Rows.count - 1).Offset(1).SpecialCells(xlCellTypeVisible)