循环用于确定A列中不同条目的第一行和最后一行

时间:2016-06-30 15:16:29

标签: vba excel-vba excel

我正在寻找一个循环代码,它为我提供了一个'名称'的第一行和最后一行。在A栏中。

    A 
 1 Phill
 2 Phill
 3 Phill
 4 Phill
 5 Phill
 6 Phill
 7 Matthew
 8 Matthew
 9 Matthew
10 Matthew
11 Hendry
12 Hendry
13 Hendry
etc. etc.

结果在其他表格上应该是这样的:

   A          B           C
1 Name     Start_Row   End_Row
2 Phill       1           6
3 Matthew     7          10
4 Hendry     11          13    
5 etc.       etc.        etc.        

我尝试了不同的循环,但似乎无法获得让我开始的良好循环代码。 这就是我所拥有的:

If wsData.Cells(i + DOF, 1) <> curName Then

 wbMain.Activate

For i = 1 To LastRow
curName = wsData.Cells(i + DOF, 1).Value
NameCount = NameCount + 1
wbWellsTable.Sheets("Sheet1").Cells(NameCount + 1, 1) = wbMain.Sheets("Data").Rows(i + DOF)
Start_Row = wsData.Cells(i + DOF, 1).Value
Counter = Counter + 1
wbWellsTable.Sheets("Sheet1").Cells(Counter + 1, 2) = wbMain.Sheets("Data").Rows(i + DOF)
End_Row = wsData.Cells(i + DOF, 1).Value
Bounter = Bounter + 1
wbWellsTable.Sheets("Sheet1").Cells(Bounter + 1, 3) = wbMain.Sheets("Data").Rows(i + DOF)
Next i
End If

希望你们能帮助我!

4 个答案:

答案 0 :(得分:1)

我不会为输出等编写整个代码,但这是一个很好的通用函数来返回第一个&amp;最后一行:

Function FindRow(sht As Worksheet, Col As String, str As String, Direction As Long) As Long
        FindRow = sht.Columns(Col).Cells.Find(str, SearchOrder:=xlByRows, LookIn:=xlFormulas, SearchDirection:=Direction).Row
End Function

您可以在常规子/函数中调用它:

Dim FirstRow As Long, LastRow As Long
FirstRow = FindRow(sht:=YourWorkSheetObject, Col:="A", str:="Text To Find", Direction:=xlNext)
LastRow = FindRow(sht:=YourWorkSheetObject, Col:="A", str:="Text To Find", Direction:=xlPrevious)

根据方向,它只返回指定列中与您想要的文本匹配的第一行或最后一行的行号。使用这些值,您应该能够将它们分解为代码的其余部分。

答案 1 :(得分:1)

如果没有 VBA ,请将名称放在 B 列中。在 C1 中输入:

=MATCH(B1,A:A,0)

并向下复制并在 D1 中输入:

=LOOKUP(2,1/(A:A=B1),ROW(A:A))

并复制下来:

enter image description here

答案 2 :(得分:0)

使用VBA:

Option Explicit

Sub rowfinder()

Dim ws As Worksheet
Dim rng As Range
Dim cell As Range
Dim currentName As String
Dim currentMin As Integer
Dim startRow As Integer
Dim startColumn As Integer
Dim outputColumn As Integer
Dim outputRow As Integer

Set ws = ThisWorkbook.Worksheets(1)
startRow = 2
startColumn = 1
outputColumn = 2
outputRow = 2
ws.Cells(startRow + 1, startColumn).End(xlDown).Select


Set rng = ws.Range(ws.Cells(startRow + 1, startColumn), ws.Cells(startRow + 1, startColumn).End(xlDown))
currentName = ws.Cells(startRow, startColumn).Value
currentMin = Cells(startRow, startColumn).Row
ws.Cells(outputRow, outputColumn).Value = currentName
ws.Cells(outputRow, outputColumn + 1).Value = currentMin
For Each cell In rng

    If cell.Value <> currentName Then

        ws.Cells(outputRow, outputColumn + 2).Value = cell.Row - 1
        currentName = cell.Value
        currentMin = cell.Row
        outputRow = outputRow + 1
        ws.Cells(outputRow, outputColumn).Value = currentName
        ws.Cells(outputRow, outputColumn + 1).Value = currentMin

    End If

Next cell
Set cell = rng.End(xlDown)
ws.Cells(outputRow, outputColumn + 2).Value = cell.Row

End Sub

Output example

答案 3 :(得分:0)

使用工作表名称

Dim wsData as Worksheet
Dim wsMain as Worksheet

Set wsData = wbMain.Sheets("Data")
Set wsMain = wwbWellsTable.Sheets("Sheet1")

' Get first value
i = 1
lastName = wsData.Cells(i, 1).Value

i = i + 1
curName = wsData.Cells(i, 1).Value
startRow = i

NameCount = 1

Do until curName = ""
    if curName <> lastName then
        With wksMain
            NameCount = NameCount + 1 ' increment row to skip first header line
            .Cells(NameCount, 1) = lastName
            .Cells(NameCount, 2) = startRow
            .Cells(NameCount, 3) = i - 1 ' last Row
        End With
        lastName = curName  
        startRow = i
    endif

    i = i + 1
    curName = wsData.Cells(i, 1).Value
Loop

' Write out lst record
With wksMain
    NameCount = NameCount + 1
    .Cells(NameCount, 1) = lastName
    .Cells(NameCount, 2) = startRow
    .Cells(NameCount, 3) = i - 1 ' last Row
End With