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”）。

编辑：第二部分

因此，首先我添加了Option Explicit，以确保您正确输入了尺寸（否则可能会出错）然后，我将您的第一个我更改为100000，将我的更改为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

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

1 个答案: