Найти строку на одном листе и выбрать ее на другом - PullRequest
1 голос
/ 29 октября 2019

У меня есть Рабочая тетрадь, в которой указаны имена и часы работы сотрудников. Я ищу для сравнения строк в одном рабочем листе (диапазон B6: CC6) и нахожу его в другом с выбором в ячейке с именем сотрудника (диапазон A1: A5000), когда я меняю листы с 1 на 2.

Пробовалнекоторые Range.Find и другие, не знаю, как это сделать

Public Sub FindPosition()

    Dim Actcol As Integer, Pos As Range, Name As Range

    Actcol = ActiveCell.Column
    MsgBox "ActiveCell is" & Actcol
    Set Pos = Cells(6, Actcol)
    MsgBox Pos

    Pos.Select

    If Worksheets("Sheet2").Activate Then

        Worksheets("Sheet2").Range("A1:AA5100").Select
        Set Name = Selection.Find(Pos, LookIn:=xlValues)

    End If

End Sub

Ответы [ 3 ]

0 голосов
/ 29 октября 2019

Это может вам помочь

Option Explicit

Sub test()

    Dim i As Long, LastRowA As Long, LastRowB As Long
    Dim rngSearchValues As Range, rngSearchArea As Range
    Dim ws1 As Worksheet, ws2 As Worksheet

    'Set you worksheets
    With ThisWorkbook
        'Let say in this worksheet you have the names & hours
        Set ws1 = .Worksheets("Sheet1")
        'Let say in this worksheet you have the list of names
        Set ws2 = .Worksheets("Sheet2")
    End With

    'Find the last row of the column B with the names from the sheet with names & hours
    LastRowB = ws1.Cells(ws1.Rows.Count, "B").End(xlUp).Row
    'Find the last row of the column A with the names from the sheet with list of names
    LastRowA = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row

    'Set the range where you want to check if the name appears in
    Set rngSearchArea = ws2.Range("A1:A" & LastRowA)

    'Loop the all the names from the sheet with names and hours

    For i = 6 To LastRowB

        If ws1.Range("B" & i).Value <> "" Then

            If Application.WorksheetFunction.CountIf(rngSearchArea, "=" & ws1.Range("B" & i).Value) > 0 Then
                MsgBox "Value appears"
                Exit For
            End If

        End If

    Next i

End Sub
0 голосов
/ 30 октября 2019

Да, я нашел решение. Спасибо всем за помощь.

    Public Sub Position()
        Dim Accol As Integer
        Dim Pos As Range
        Dim name As Range
        ActiveSheet.name = "Sheet1"
        Accol = ActiveCell.Column
        Set Pos = Cells(6, Accol)
        Worksheets("Sheet2").Activate
        Worksheets("Sheet2").Range("a1:a5000").Select
        Set name = Selection.Find(What:=Pos, After:=ActiveCell, LookIn:=xlValues, LookAt:=xlPart, _
        SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
        name.Select

    End Sub

Последняя вещь, которую я хотел бы сделать, которую я не могу решить, - это где автоматически писать скрипт, выполняющийся при выборе Sheet2?

0 голосов
/ 29 октября 2019

Во-первых, если вы хотите запустить какой-либо макрос путем активации Sheet2, вам нужно обработать Activate событие Sheet2. Это можно сделать, объявив подпрограмму в модуле Sheet следующим образом.

Private Sub Worksheet_Activate()
    'Codes you want to be run when Sheet2 is activated.
End Sub

Во-вторых, простой способ найти ячейку с определенным значением - использовать WorksheetFunction.Match. Например,

Dim SearchInRange As Range
Set SearchInRange = Range("A1:A5000")

Dim EmployeeName As Variant
EmployeeName = ... 'Actual employee name you want to search

On Error GoTo NotFound
Dim Index As Variant
Index = WorksheetFunction.Match(EmployeeName, SearchInRange, 0)
On Error GoTo 0

SearchInRange.Cells(Index).Select

GoTo Finally

NotFound:
' Handle error

Finally:

Range.Find также может работать, но помните, что у него есть побочный эффект изменения состояния диалогового окна «Найти и заменить».

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...