将单元格值与VBA中的多个值范围进行比较

Question

我是 VBA 的业余爱好者，目前正在处理一个问题，例如，如果 Range("Profesija"( 与单元格 G4(即范围"G4：ED4"的成员(的值匹配，并且单元格 G5(或下面的任何单元格(包含一个数字，则单元格 B5(与 G5 位于同一行(的值将放入单元格 Kaitigieee。

这是我的初稿：

Dim n As Range
Set n = Sheets("Matrix").Range("G4:ED4")
For Each c In n
If Range("Profesija") = n.value And n.value(0, -i) <> 0 Then
Range("Kaitigieee") = n.value(2, 0)
End If

任何建议将不胜感激。

目前，我坚持调试以下代码文章：

Sub CopyData()
NewBook = ""
path = ThisWorkbook.path
Sheets("Staff").Select
For i = 2 To 100000
If Cells(i, 1).value = "" Then
i = 100000
Exit For
End If
Dim mainWB  As Workbook
Dim mainWS  As Worksheet
Dim n, c As Range
Dim LastRow As Long
Dim j As Long
Set mainWB = ActiveWorkbook
Set mainWS = mainWB.Sheets("Matrix")
LastRow = mainWS.Range("B" & Rows.Count).End(xlUp).Row
Set n = Sheets("Matrix").Range("G4:ED4")

Name_file = path & "" & Sheets("Staff").Cells(i, 1).value & 
Sheets("Staff").Cells(i, 2).value & ".xls"
Sheets("TEMPLATE_TARGET").Select

Range("Vardsuzvards").value = Sheets("Staff").Cells(i, 1).value & " " & _
Sheets("Staff").Cells(i, 2).value & " "
Range("Personaskods").value = Sheets("Staff").Cells(i, 3).value
Range("Dzivesvieta").value = Sheets("Staff").Cells(i, 4).value
Range("Profesija").value = Sheets("Staff").Cells(i, 5).value
For Each c In n
If Range("Profesija").value = c.value Then
For j = 1 To LastRow - c.Row
If c.Offset(j, 0).value <> 0 Then
Range("Kaitigieee").value = c.Offset(j, -3).value           ' From G5 
to B5 is offset(0,-3)
Exit Sub
End If
Next j
End If
Next c
Cells.Select
Selection.Copy
If NewBook = "" Then
Workbooks.Add
NewBook = ActiveWorkbook.Name
Else
Workbooks(NewBook).Activate
Cells(1, 1).Select
End If
Application.DisplayAlerts = False
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Filename:= _
Name_file, FileFormat:=xlExcel8, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
NewBook = ActiveWorkbook.Name
Application.DisplayAlerts = True
Workbooks("OVP_v1.xlsm").Activate
Sheets("Staff").Select
Next i

Workbooks(NewBook).Close
MsgBox ("YAY")

End Sub

上面提到的代码的循环被卡在所需数据表的中间，并一直忽略定义"Kaitigieee"单元的命令。我想我的问题是我试图同时从两个不同的工作簿工作表中收集大量数据，但我不确定如何解决它。

Answer 1

这个问题有点模糊，但我认为这应该纠正您的代码：

Sub test()

Dim mainWB  As Workbook
Dim mainWS  As Worksheet
Dim n, c As Range
Dim i As Long
Set mainWB = ActiveWorkbook
Set mainWS = mainWB.Sheets("Matrix")

Dim LastRow As Long
LastRow = mainWS.Range("B" & Rows.Count).End(xlUp).Row      'Replace G by your longest Column
Set n = Sheets("Matrix").Range("G4:ED4")
For Each c In n
If Range("A1").Value = c.Value Then
For i = 1 To LastRow - c.Row
If c.Offset(i, 0).Value <> 0 Then
Range("A2").Value = c.Offset(i, -3).Value           ' From G5 to B5 is offset(0,-3)
Exit Sub
End If
Next i
End If
Next c
End Sub

请注意，在我的示例中，我更改了：Range("Profesija"(由Range("A1"(和Range("Kaitigieee"(由Range("A2"(更改。

编辑：第二部分

因此，首先我添加了选项显式以确保正确输入维度(否则您可能会遇到错误( 然后我把你的第一个 i 更改为 100000 到 a for 到 Lastrow。我想这就是你正在做的事情。

最后，最大的变化是增加了细胞。

Option Explicit
Sub CopyData()
Dim mainWB  As Workbook
Dim mainWS  As Worksheet
Dim n, c As Range
Dim LastRow As Long
Dim j As Long
Dim Path, Newbook As String
Newbook = ""
Path = ThisWorkbook.Path
Set mainWB = ActiveWorkbook
Set mainWS = mainWB.Sheets("Matrix")
Set n = Sheets("Matrix").Range("G4:ED4")
LastRow = mainWS.Range("B" & Rows.Count).End(xlUp).Row
Sheets("Staff").Select
For i = 2 To LastRow
Name_file = Path & "" & Sheets("Staff").Cells(i, 1).Value & Sheets("Staff").Cells(i, 2).Value & ".xls"
Sheets("TEMPLATE_TARGET").Select

Range("Vardsuzvards").Value = Range("Vardsuzvards").Value + Sheets("Staff").Cells(i, 1).Value + Sheets("Staff").Cells(i, 2).Value ' I don't understand why you wanted the " " here
Range("Personaskods").Value = Range("Personaskods").Value + Sheets("Staff").Cells(i, 3).Value
Range("Dzivesvieta").Value = Range("Dzivesvieta").Value + Sheets("Staff").Cells(i, 4).Value
Range("Profesija").Value = Range("Profesija").Value + Sheets("Staff").Cells(i, 5).Value
For Each c In n
If Range("Profesija").Value = c.Value Then
For j = 1 To LastRow - c.Row
If c.Offset(j, 0).Value <> 0 Then
Range("Kaitigieee").Value = Range("Kaitigieee").Value + c.Offset(j, -3).Value
Exit Sub
End If
Next j
End If
Next c
Cells.Copy
If Newbook = "" Then
Workbooks.Add
Newbook = ActiveWorkbook.Name
Else
Workbooks(Newbook).Activate
Cells(1, 1).Select
End If
Application.DisplayAlerts = False
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Filename:=Name_file, FileFormat:=xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
Newbook = ActiveWorkbook.Name
Application.DisplayAlerts = True
Workbooks("OVP_v1.xlsm").Activate
Sheets("Staff").Select
Next i

Workbooks(Newbook).Close
MsgBox ("YAY")

End Sub