我有一个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代码。
提前致谢。
答案 0 :(得分:0)
这应该可以解决问题;它将A:C范围单元格复制到B010和B016之间的任何B单元格值到Sheet2中的下一个可用行。
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