VBA値の場合は行をチェックし、別の値の場合はTrueを貼り付けます

Question

私は短い説明と長い説明の部品番号のリストを持っています。リストは、最初の列に部品番号があるようにフォーマットされています。 2番目の列には説明コードがあります。 3列目には説明があります。説明は、名前、短い説明、または前述の説明コードに基づく長い説明のいずれかです。

参照してください。スクリーンショットの例： Original Dataset

あなたが見ることができるように、部品の一部は、3つのすべての記述があり、そのうちのいくつかにはありません。

私はシート1からデータを取得して、シート2に情報を貼り付けようとしています。これは、統合された適切な行構造を持っています。部品番号、名前、ショート、ロング。

を参照してくださいスクリーンショットの例：ここではNew Dataset

は、私が取り組んできたいくつかのコードです。私は近くにいるか、少なくとも適切なトラックにいるように感じますが、間違いなく動作していなくて、次のエラーを出さないことは間違いありません。

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 

すべてのヘルプは非常に高く評価されます。私は実際には、この1枚のシートをループして物を取り出し、別のシートに貼り付けようとしています。十分に簡単に聞こえます。

Answer 1

私は、あなたのコードにいくつかのマイナーな変更を加えるだろう主にあなたが先のシート上に書き込みをしている行のカウンタを維持するために、プラスかなりの数の化粧品の変更：

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 

---

あなたの最初の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"