VBA скопировать найденное значение - PullRequest
0 голосов
/ 25 февраля 2019

Я довольно новичок в VBA.Я пытался заставить этот код работать безрезультатно, в основном у меня есть поиск, чтобы найти значение (эта часть работает), и я хочу скопировать это значение и строку, где это значение находится на другом листе на следующем пустомстрока и дата отметьте это.Любая помощь будет оценена.Большое спасибо.

Это образец таблицы: Пример таблицы

Это код, который у меня наполовину работает:

Sub FindingValues()
    Dim val As String
    Dim result As String
    Dim firstAddress As String
    Dim c As Range


    val = InputBox("Enter ID")
    Set c = Sheets("Sheet1").Range("E:E").Find(val, LookIn:=xlValues, _
                                               MatchCase:=False)


    If Not c Is Nothing Then
        firstAddress = c.Address
'        Application.Goto c
        Copy.Sheets(Sheet2).c

            Set c = Cells.FindNext(c)
        Else
         If c Is Nothing Then

         MsgBox "Could Not Find " & Res

         End If


        End If

1 Ответ

0 голосов
/ 25 февраля 2019

Я думаю, что это должно сделать это ...

Sub FindingValues()
Dim val As String, result As String, firstAddress As String, entryROW As Long
Dim c As Range

'PGCodeRider making assumption to inser in column A
Dim columnNumberToPasteData As Long
columnNumberToPasteData = 1

'assumes Sheet2 is where data should be copied
Dim WS2 As Worksheet
Set WS2 = Sheets("Sheet2")


val = InputBox("Enter ID")

'probably want something like this so that if user wants to cancel
If val = "" Then Exit Sub


Set c = Sheets("Sheet1").Range("E:E").Find(val, LookIn:=xlValues, _
                                           MatchCase:=False)

If Not c Is Nothing Then

    entryROW = WS2.Cells(Rows.Count, columnNumberToPasteData).End(xlUp).Row + 1

    WS2.Rows(entryROW).Value = c.Worksheet.Rows(c.Row).Value
    WS2.Cells(entryROW, Columns.Count).End(xlToLeft).Offset(0, 1).Value = VBA.Now

'    With WS2.Cells(entryROW, columnNumberToPasteData)
'        .Offset(0, 0).Value = c.Value
'        .Offset(0, 1).Value = c.Row
'        .Offset(0, 2).Value = Now()
'    End With
'
Else

    If c Is Nothing Then MsgBox "Could Not Find " & val

End If

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