VBA检查行以获取值,然后再进行另一个值,并粘贴(如果为true)



我有一个零件编号的列表,这些零件编号具有简短的描述和较长的描述。该列表的格式是在第一列中有一个零件号。在第二列中有一个描述代码。在第三列中有一个描述。描述是基于上述说明代码的名称,简短描述或长描述。

请参阅屏幕截图示例:原始数据集

您可以看到,其中一些零件都有所有三个描述,有些则没有。

我正在尝试从表1获取数据,并将信息粘贴到具有合并和正确的行结构的表2中。零件号,名称,短,长。

请参阅屏幕截图示例:新数据集

这是我一直在使用的一些代码。我觉得我很接近或至少在正确的轨道上,但是它肯定不起作用,目前在没有错误的情况下投掷下一个。

Dim i As Long
For i = 1 To Rows.Count
With ActiveWorkbook
.Sheets("Parts List").Range("A1").Select
    If .Sheets("Parts List").Cells(i, 1).Value = .Sheets("Product Description").Cells(i, 1) Then
    If .Sheets("Product Description").Cells(i, 2).Value = "DES" Then
    .Sheets("Parts List").Cells(i, 2).Value = .Sheets("Product Description").Cells(i, 2).Value
    ElseIf .Sheets("Product Description").Cells(i, 2).Value = "EXT" Then
    .Sheets("Parts List").Cells(i, 5).Value = .Sheets("Product Description").Cells(i, 2).Value
    ElseIf .Sheets("Product Description").Cells(i, 2).Value = "MKT" Then
    .Sheets("Parts List").Cells(i, 3).Value = .Sheets("Product Description").Cells(i, 2).Value
End If
Next i
End With

任何人都将不胜感激。我真的只是想让它循环通过这张纸,提取物品并将其放在另一张纸上。听起来很容易。

我会对您的代码进行一些较小的更改,主要是为了保留您在目标表上写下哪一行的计数器,以及相当多的化妆品更改:

Dim srcRow As Long
Dim dstRow As Long
Dim srcWs As Worksheet
Dim dstWs As Worksheet
Set srcWs = ActiveWorkbook.Worksheets("Product Description")
Set dstWs = ActiveWorkbook.Worksheets("Parts List")
dstRow = 9  'Initially point to the header row
'Only do your For loop for cells that contain a product code, rather than
'for the 1 million rows in the worksheet
For srcRow = 1 To srcWs.Range("A" & srcWs.Rows.Count).End(xlUp).Row
    '.Sheets("Parts List").Range("A1").Select  'Not needed
    If dstWs.Cells(dstRow, "A").Value <> srcWs.Cells(srcRow, "A") Then
        'Increment destination row
        dstRow = dstRow + 1
        'Store part number
        dstWs.Cells(dstRow, "A").Value = srcWs.Cells(srcRow, "A").Value
    End If
    'Store other data
    Select Case srcWs.Cells(srcRow, "B").Value
        Case "DES"
            dstWs.Cells(dstRow, "B").Value = srcWs.Cells(srcRow, "C").Value
        Case "EXT"
            dstWs.Cells(dstRow, "E").Value = srcWs.Cells(srcRow, "C").Value
        Case "MKT"
            dstWs.Cells(dstRow, "C").Value = srcWs.Cells(srcRow, "C").Value
    End Select
Next

您遇到的"下一个无a"错误是由于无与伦比的If语句(您的第一个If语句没有相应的End If),并且您的With块在For循环内开始,但在循环结束后完成。通过始终/始终缩进代码,可以轻松地获取这种错误。下面是您的原始代码一旦被缩进的样子:

Dim i As Long
For i = 1 To Rows.Count
    With ActiveWorkbook
        .Sheets("Parts List").Range("A1").Select
        If .Sheets("Parts List").Cells(i, 1).Value = .Sheets("Product Description").Cells(i, 1) Then
            If .Sheets("Product Description").Cells(i, 2).Value = "DES" Then
                .Sheets("Parts List").Cells(i, 2).Value = .Sheets("Product Description").Cells(i, 2).Value
            ElseIf .Sheets("Product Description").Cells(i, 2).Value = "EXT" Then
                .Sheets("Parts List").Cells(i, 5).Value = .Sheets("Product Description").Cells(i, 2).Value
            ElseIf .Sheets("Product Description").Cells(i, 2).Value = "MKT" Then
                .Sheets("Parts List").Cells(i, 3).Value = .Sheets("Product Description").Cells(i, 2).Value
            End If
        'Notice that the Next i is not lined up with the For i
        Next i
    End With
'Notice that we haven't ended up back at the left - so we must be missing
'the end of some sort of "block"

最新更新