0

たくさんの行といくつかの列を含むExcelワークシートがあります。1 列目には製造元の名前、2 列目にはすべての製品の製品コード、3 列目には説明などが含まれます。特定の製品コードに対応する行をコピーする必要があります。例えば：

**Manufacturer       Product code       Description**
abc                 B010                blah blah
dgh                 A012                
hgy                 X010                
eut                 B013                 
uru                 B014                 
eut                 B015              
asd                 G012            
sof                 B016
uet                 B016 
etc

商品コードがB010～B016の行をコピーする方法はありますか？重複/一致する製品コードも存在する可能性があり、それらもコピーしても問題ありません。

理にかなっていますか？

申し訳ありませんが、ここに入力する VBA コードはまだありません。

前もって感謝します。

4

1 に答える 1

0

これでうまくいくはずです。B010 と B016 の間の B セル値の A:C 範囲セルをシート 2 の次の使用可能な行にコピーします。

Private Sub CopyRows()
    Dim lastrow As Long
    Dim r1 As Long, r2 As Long

    ' Get the last row in the worksheet
    lastrow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row

    r2 = 1

    For r1 = 1 To lastrow
        ' If the last three characters of the B cell are numeric...
        If IsNumeric(Right(Sheet1.Range("$B$" & r1).Value, 3)) Then
            ' If the first character of the B cell is "B", and the last three 
            ' characters are between 10 and 16 ...
            If Left(Sheet1.Range("$B$" & r1).Value, 1) = "B" And _
                CLng(Right(Sheet1.Range("$B$" & r1).Value, 3)) >= 10 And _
                CLng(Right(Sheet1.Range("$B$" & r1).Value, 3)) <= 16 Then

                ' ... copy the A-C range for the row to the next available row 
                ' in Sheet2
                Sheet2.Range("$A$" & r2, "$C$" & r2).Value = _
                    Sheet1.Range("$A$" & r1, "$C$" & r1).Value

                r2 = r2 + 1

            End If
        End If
    Next
End Sub
于 2012-07-19T20:29:13.663 に答える