VBA Excel 用户输入查找数据不同的工作簿

Question

我的编程水平很低，但是，因为我是公司里的"skilled"，所以我向你们寻求支持，希望你们能帮助我！

我手头的任务如下。

我有一个工作簿，其中所有数据条目都已完成，然后我有一个数据库文件，还有 excel。

用户文件：随机名称，因为sheet会根据用户的计算而改变。 Sheet 姓名 "Sagsnr." （案例。用当地语言表示）

源文件："Matcost.xls"，作品sheet："Matcost"

我需要能够输入一个值，例如将一个 material 数字或数字范围（因此范围是动态的）放入活动 sheet，然后它将开始在数据库文件中查找与 ID（Mat.number）相关的特定数据字段.

我需要在从数据库中获取的各种数据之间有计算字段，所以我不能只复制整行，而是需要为每个 ID 号从数据库中的单元格中获取一组值到用户输入文件。

我只想获取值而不是将 vlookup 函数粘贴到 sheet 中，因为这“从用户操作的角度来看是危险的，而且会使 sheet 变慢以我的经验。

我现在已经为上述问题苦苦挣扎了一段时间，我也尝试在这个网站上查找各种问题和答案，但没有明显的工作解决方案。这可能是我的理解不够，但我希望你能指出正确的答案或在这里回答。

Private Sub Worksheet_Change(ByVal Target As Range)

Dim material As String
Dim fndEntry As Range
Dim wb1 As Workbook, wb2 As Workbook

Set wb1 = ActiveWorkbook

material = wb1.ActiveCell.Value

' Find the corresponding value in the Database file

Workbooks.Open Filename:="G:\Backoffice\Tilbudsteam\Kostdatabase\Matcost.xls", ReadOnly:=True

Set wb2 = ActiveWorkbook

'Change the below Range address..
Set fndEntry = wb2.Range("C:C").Find(What:=material)

'Change the below Range address..
If Not fndEntry Is Nothing Then
    wb2.Range("B" & fndEntry.Row).Copy Destination:=wb1.ActiveCell.Offset(0, 1)
End If


End Sub

非常感谢您！

User input sheet

Answer 1

您可能需要将您的方法放在 'WorkSheet' 本身上，以便能够在您输入 'material number'

时注明

Private Sub Worksheet_Change(ByVal Target As Range)

...

End Sub

在其中您可能需要一个 find ActiveSheet 和数据库文件之间的方法

Dim material As Variant
Dim fndEntry As Range
Dim wb1 As Workbook, wb2 As WorkBook

Set wb1 = ActiveWorkbook

material = wb1.ActiveSheet.ActiveCell.Value

' Find the corresponding value in the Database file

Workbooks.Open Filename:="C:\Somewhere\DataBase.xls

Set wb2 = ActiveWorkbook

更改以下范围地址..

Set fndEntry = wb2.Sheets("xxx").Range("A:A").Find(What:=material)

更改以下范围地址..

If Not fndEntry Is Nothing Then
    wb2.Sheets("xxx").Range("B" & fndEntry.Row).Copy Destination:= wb1.ActiveSheet.ActiveCell.OffSet(0,1)
End If

在没有任何代码的情况下准确指出你想做什么是不可行的，但上面的内容可以完成工作，只是你必须更改某些单元格、数据的地址..或扩展你需要的内容return 到初始工作表。

编辑

这应该可以解决您的动态问题，它会检查您在 C 列中粘贴、输入了多少条目，然后 return 是每个条目的数据。您需要将目标列更改为底部

Private Sub Worksheet_Change(ByVal Target As Range)

Dim material As Variant
Dim fndEntry As Range
Dim wb1 As Workbook, wb2 As WorkBook
Dim lr As Integer

If Not Target.Column = 3 Then
    Exit Sub
End If

Set wb1 = ActiveWorkbook

lr = wb1.Sheets("Sagsnr.").Range("C1:C" & rows.Count).End(xlUp).Row

If lr < 22 Then
    Exit Sub
End If

Workbooks.Open Filename:="G:\Backoffice\Tilbudsteam\Kostdatabase\Matcost.xls", ReadOnly:=True

Set wb2 = ActiveWorkbook

For i = 22 To lr

    material = wb1.Sheets("Sagsnr.").Range("C" & i).Value

    Set fndEntry = wb2.Sheets("Matcost").Range("C:C").Find(What:=material)

    If Not fndEntry Is Nothing Then
        wb2.Sheets("Matcost").Range("E" & fndEntry.Row).Copy Destination:= wb1.Sheets("Sagsnr.").Range("destination column - change me" & i)
    End If

Next i

wb2.Close

End Sub

VBA Excel 用户输入查找数据不同的工作簿

VBA Excel User input lookup data different workbook

excel

vba

worksheet

vlookup