☰

在 Excel 中，如何自动更改单元格的数据（VBA）？

tag-icon • tag-icon microsoft-excel-2010 vba
在 Excel 中，如何自动更改单元格的数据（VBA）？

我想在将数据粘贴到单元格中时自动更改单元格的内容。数据将粘贴到 Excel 工作表的 Q 列中。我需要将其与另一张名为“用户”的工作表的 A 列中的数据进行匹配，并从同一工作表的 B 列返回相应的值。我推测这需要使用 VBA，尽管我对 VBA 编码了解甚少！

任何帮助都将非常感谢！

答案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

前

在此处输入图片描述

后

在此处输入图片描述

相关内容