我自己解决了。我添加了一个for循环。这是我的工作代码。感谢所有其他人试图提供帮助。
Sub runMatch()
Dim critRemID, listRemID, critRemIDstart, listRemIDstart As Range
Set critRemID = Worksheets("Enterprise - score").Cells(2, 1)
Set listRemID = Worksheets("Sheet1").Cells(2, 1)
Set critRemIDstart = Worksheets("Enterprise - score").Cells(2, 30)
Set listRemIDstart = Worksheets("Sheet1").Cells(2, 2)
Dim i, j, index As Integer
i = 0
j = 0
Do While critRemID.Offset(i, 0) <> ""
If critRemID.Offset(i, 0) = listRemID.Offset(j, 0) Then
For index = 0 To 84
critRemIDstart.Offset(i, index) = listRemIDstart.Offset(j, index).Value
Next index
i = i + 1
j = 0
index = 0
Else
If listRemID.Offset(j, 0) = "" Then
j = 0
i = i + 1
Else
j = j + 1
End If
End If
Loop
End Sub
我有两张纸,每张纸都有相同的ID但是 不同的数据集。
我想扫描数据行,如果匹配,请复制 整行从某一列到另一列的某一列 其中一张纸的末尾。
第1页是我要复制信息的表格,最后我已经创建了 我希望从表2中带来的数据的标题相同。
下面的代码就是我所拥有的,我为ID设置了一个范围 我希望复制的单元格在哪里开始
Dim critRemID, listRemID, critRemIDstart, listRemIDstart As Range Set critRemID = Worksheets("Enterprise - score").Cells(2, 1) Set listRemID = Worksheets("Sheet1").Cells(2, 1) Set critRemIDstart = Worksheets("Enterprise - score").Cells(2, 30) Set listRemIDstart = Worksheets("Sheet1").Cells(2, 90) Dim i, j As Integer i = 0 j = 0 Do While critRemID.Offset(i, 0) <> "" If critRemID.Offset(i, 0) = listRemID.Offset(j, 0) Then critRemIDstart.Row(i) = listRemIDstart.Row(j).Value i = i + 1 j = 0 Else j = j + 1 End If Loop
我一直收到此错误
参数数量错误或属性分配无效
我尝试了一条不同的路线,但如图所示一直感到困惑 下面。我试图让它逐个复制每个单元格 到达一个空单元格,它将移动到主要的下一个ID 表并重新开始,但这没有任何作用,我认为它保持不变 增加工作表上的两个ID,永远不会找到匹配项。
If critRemID.Offset(i, 0) = listRemID.Offset(j, 0) Then critRemIDstart.Offset(i, k) = listRemIDstart.Offset(j, l).Value k = k + 1 l = l + 1 Else If listRemIDstart.Offset(j, l) = "" Then j = j + 1 l = 0 i = i + 1 k = 0 Else j = j + 1 i = i + 1 l = 0 k = 0 End If End if
任何帮助表示赞赏。感谢。
答案 0 :(得分:1)
Range.Find
方法可以轻松找到密钥。
Dim critRem, listRem As Worksheet
Set critRem = Worksheets("Enterprise - score")
Set listRem = Worksheets("Sheet1")
Dim critRemID, listRemID, cell, matchedCell As Range
With critRem
Set critRemID = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With
With listRem
Set listRemID = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With
For Each cell In critRemID
Set matchedCell = listRemID.Find(cell.Value)
If matchedCell Is Nothing Then 'ID is not found
'Do nothing
Else 'ID is found, matchedCell is pointed to column A now
cell.Offset(0, 29).Resize(1, 10) = matchedCell.Offset(0, 89).Resize(1, 10)
'offset(0,29) means offsetting right 29 columns
'resize(0,10) means resizing the range with 1 row and 10 columns width
'feel free to change the number for your data
End If
Next cell
注意:如果您对offset().resize()
感到困惑,还有另一种方法。 cell.Row
为您提供应写入数据的行,matchedCell.Row
为您提供ID匹配的行。因此,您可以通过listRem.Range("D" & matchedCell.Row)
答案 1 :(得分:1)
如果你说两个工作表具有相同的ID,那么为什么不使用Vlookup函数将数据带入Sheet1,然后只需复制结果并粘贴为值,这样就可以去除它们上面的公式?
像循环运行的东西:
For i = 1 to LastRow
Sheet1.cells(i, YourColumnNumber).value = "=VLOOKUP(RC[-1], Sheet2!R1:R1048576, 3, False)"
Next i
答案 2 :(得分:1)
Tried to do it using the loop.
Sub Anser()
Dim critRemID As Range
Dim listRemID As Range
Dim critRemIDstart As Range
Dim listRemIDstart As Range
'::::Change Sheet names and column numbers:::::
Set critRemID = Worksheets("Sheet1").Cells(2, 1)
Set listRemID = Worksheets("Sheet2").Cells(2, 1)
Set critRemIDstart = Worksheets("Sheet1").Cells(2, 2)
Set listRemIDstart = Worksheets("Sheet2").Cells(2, 2)
Dim i, j As Integer
i = 0
j = 0
Do
If critRemID.Offset(i, 0) = listRemID.Offset(j, 0) Then
critRemIDstart.Offset(i) = listRemIDstart.Offset(j)
i = i + 1
j = 0
Else
j = j + 1
End If
Loop While critRemID.Offset(i, 0) <> ""
End Sub