В Excel, как я могу автоматически изменить данные ячейки (VBA)?

Question

Я хотел бы автоматически изменять содержимое ячеек, когда в них вставляются данные. Данные будут вставлены в столбец Q листа в Excel. Мне нужно, чтобы он сопоставлялся с данными в столбце A другого листа под названием «Пользователи» и возвращал соответствующее значение из столбца B того же листа. Я предполагаю, что это потребует использования VBA, хотя я очень плохо разбираюсь в кодировании VBA!

Любая помощь будет очень ценится!

Answer 1

Я не верю, что ты можешь делать то, что хочешь. Нет способа (о котором я знаю) обнаружить только пасты.

Наиболее близким является использование

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

Но это означает, что он срабатывает каждый раз, когда вносятся какие-либо изменения на странице.

Таким образом, в качестве обходного пути вы можете вставить в Col Q, а затем вручную запустить макрос (который можно назначить кнопке, если проще).

Option Explicit

Sub MatchThePairs()

'You can edit this top bit

'The name of column you are pasting into
Dim pastedCol As String
pastedCol = "Q" 'UPDATE ME IF NEEDED

'The name of the look up column
Dim lookupCol As String
lookupCol = "Z" 'UPDATE ME IF NEEDED

'The name of the look to show results
Dim resultCol As String
resultCol = "AA" 'UPDATE ME IF NEEDED

'Do you want to clear the results first ?
Dim clearResults As Boolean
clearResults = True 'CHANGE ME TO True OR False

'What is the row of the header (if you have one)
Dim rowHeader As Integer
rowHeader = 1 ' set to 0 if no header

'What is the name of the results column
Dim resultsColHeader As String
resultsColHeader = "ResultsCol" ' Change me to what ever

'what is the first row (do not include the headings)
Dim row As Integer
row = 2 'AS PER THE SCEEN SHOT, I STARTED ON ROW 2



' **** hopefully you won't need to edit anything below this

If clearResults Then
    Range(resultCol & ":" & resultCol).Cells.Clear

    If rowHeader > 0 Then
       Range(resultCol & rowHeader).Value = resultsColHeader
    End If


End If

Do While (Range(pastedCol & row).Value <> "")

    If Range(pastedCol & row).Value = Range(lookupCol & row).Value Then
        'yipee, a match
        Range(resultCol & row).Value = Range(lookupCol & row).Value
    End If
    row = row + 1
Loop

End Sub

До

После