VBA检查行的值然后另一个值和粘贴如果为真 [英] VBA Check Row For Value Then Another Value and Paste If True

问题描述

我有一个零件编号列表，附有简短描述和长描述。列表的格式是这样的，在第一列中有一个零件号。在第二列中有一个描述代码。在第三列有一个描述。描述是基于上述描述代码的名称，简短描述或长描述。

I have a list of parts numbers with short descriptions and long descriptions. The list is formatted in such a way that in the first column there is a part number. In the second column there is a description code. In the third column there is a description. The description is either the name, short description, or long description based on the preceding description code.

查看截图示例：
原始数据集

如您所见，某些部分有三个描述，其中一些没有。

As you can see, some of the parts have all three descriptions and some of them don't.

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

I'm trying to take the data from sheet 1 and paste the information into sheet 2 that has the consolidated and proper row structure ie. part number, name, short, long.

请参阅截图示例：新数据集

这是我一直在使用的一些代码。我觉得我很接近或至少在正确的轨道上，但绝对不能正常工作，目前正在扔下一个没有错误。

Here is some code I've been working with. I feel like I'm close or at least on the right track but it definitely isn't working and currently throwing a next without for error.

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

任何和所有帮助将不胜感激。我真的只是试图让它循环通过这一张，并提取的东西，并把它们放在另一张单上。听起来很容易

Any and all help would be greatly appreciated. I'm really just trying to get it to loop through this one sheet and extract things and put them on another sheet. Sounds easy enough.

推荐答案

我会对您的代码进行一些细微的更改，主要是为了保持您正在写的行的计数器目的地工作表，加上相当多的化妆变化：

I would make a few minor changes to your code, mainly to keep a counter of which row you are writing to on the destination sheet, plus quite a few cosmetic changes:

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

---

您收到的Next without a For错误是由于无法匹配的如果语句（您的第一个如果语句没有相应的 End If ）和您的使用块在对于循环，但在循环结束后完成。总是/一直缩进你的代码，这种错误很容易被拾取。以下是您的原始代码看起来像缩进：

---

The "Next without a For" error that you were getting was due to an unmatched If statement (your first If statement had no corresponding End If) and your With block started inside your For loop but finished after the loop ended. That type of error is easily picked up by always / consistently indenting your code. Below is what your original code looked like once it was indented:

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"

这篇关于VBA检查行的值然后另一个值和粘贴如果为真的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！