Получить идентификатор значения на листе для редактирования или обновления данных из списка на другом листе с помощью VBA-Excel - PullRequest
0 голосов
/ 07 июня 2019

О проблеме, как обновить, если идентификатор ячейки равен true с помощью кнопки через vba-excel, поэтому мне нужно обновить некоторые значения от листа 1 столбца таблицы до другого листа Список данных.

Для образца:

In Sheet1 (Редактировать или обновить любые значения ячеек)

enter image description here

На листе 2 (обновите данные, если идентификатор верен)

enter image description here

Sub update()
Dim LR1 As Long
With Sheets("Sheet2")
    LR1 = .Range("A" & .Rows.Count).End(xlUp).Row
    .Range("A" & LR1) = Sheets("Sheet1").Range("B2")
    .Range("B" & LR1) = Sheets("Sheet1").Range("B3")
    .Range("C" & LR1) = Sheets("Sheet1").Range("B4")
    .Range("D" & LR1) = Sheets("Sheet1").Range("B5")
End With
End Sub

Я надеюсь, что кто-нибудь поможет мне решить проблему

1 Ответ

2 голосов
/ 07 июня 2019

Используйте Find(), чтобы найти соответствующую строку (если есть), затем обновите эту строку: если не найдено, добавьте новую строку

Sub update()
Dim f As Range, sht1 As Worksheet
Set sht1 = Sheets("Sheet1")

With Sheets("Sheet2")
    Set f = .Range("A:A").Find(what:=sht1.Range("B1").Value, lookat:=xlWhole)
    If f Is Nothing Then Set f = .Range("A" & .Rows.Count).End(xlUp).Offset(1, 0)
    f.Resize(1, 5).Value = Application.Transpose(sht1.Range("B1:B5").Value)
End With
End Sub

РЕДАКТИРОВАТЬ: ячейка за ячейкой, если вам нужен больший контроль над тем, что и где

Sub update()

    Dim f As Range, sht1 As Worksheet
    Set sht1 = Sheets("Sheet1")

    With Sheets("Sheet2")
        Set f = .Range("A:A").Find(what:=sht1.Range("B1").Value, lookat:=xlWhole)
        If f Is Nothing Then Set f = .Range("A" & .Rows.Count).End(xlUp).Offset(1, 0)
        With f.EntireRow
            .Cells(1).Value = sht1.Range("B1").value
            'skip one cell then copy the rest...
            .Cells(3).Resize(1, 4).Value = Application.Transpose(sht1.Range("B4:B5").Value)
            'etc etc
        End With

    End With

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