[英]How to copy the value in a range of cells to another cell if only one cell in the range has a value?
[英]How to Copy a cell's range into the value of another cell
我正在編寫一個代碼,該代碼遍歷給定的單元格范圍,每個循環都有一個。 如果這些調用不滿足帶有“ for each”的if語句,則需要在另一張紙上寫該單元格的范圍。 例如:單元格A20和A36不符合要求,所以我想在另一張紙上寫A20和36。 這樣,我將獲得所有需要注意的單元格的列表。這是我的以下代碼:
r = 5
Set sht1 = Sheets("DataSheet")
Set sht2 = Sheets("DiscrepancyReport")
On Error GoTo DiscrepancySheetError
sht2.Select
On Error GoTo DataSheetError
sht1.Select
On Error GoTo 0
lastr = ActiveSheet.range("A1").Offset(ActiveSheet.Rows.Count - 1, 0).End(xlUp).Row
lastr = lastr - 1
'Column 1: WP
Set colrg = range("A3:A" & lastr)
For Each cell In colrg
If (cell.Value) = 6.01 Or (cell.Value) = 6.03 Or (cell.Value) = 3.04 Or (cell.Value) = 6.27 Then
Else
'## The following line makes no sense but i wrote it so you understand what i want to do
currentcell.range.Copy Destination:=sht2.range("A" & r)
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "Not a valid WP"
r = r + 1
End If
Next
謝謝你!
我假設您想將“無效的WP”放入DataSheet中,而無需使用Copy:
Sub CollectRanges()
r = 5
Set sht1 = Sheets("DataSheet")
Set sht2 = Sheets("DiscrepancyReport")
'On Error GoTo DiscrepancySheetError
sht2.Select
'On Error GoTo DataSheetError
sht1.Select
On Error GoTo 0
lastr = ActiveSheet.Range("A1").Offset(ActiveSheet.Rows.Count - 1, 0).End(xlUp).Row
lastr = lastr - 1
'Column 1: WP
Set colrg = Range("A3:A" & lastr)
For Each cell In colrg
If (cell.Value) = 6.01 Or (cell.Value) = 6.03 Or (cell.Value) = 3.04 Or (cell.Value) = 6.27 Then
Else
sht2.Cells(r, 1).Value = cell.Address
cell.Offset(0, 1).Value = "Not a valid WP"
r = r + 1
End If
Next
End Sub
這是更新的代碼,假設您的數據從第三行開始。
避免在代碼中使用“選擇/激活”。 引用此鏈接
Sub test()
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Dim r As Long, lastr As Long
r = 3
Set sht1 = Sheets("DataSheet")
Set sht2 = Sheets("DiscrepancyReport")
With sht1
lastr = .Range("A" & .Rows.Count).End(xlUp).Row
If lastr < 3 Then lastr = 3
Set colrg = Range("A3:A" & lastr)
End With
For Each cell In colrg
If (cell.Value) = 6.01 Or (cell.Value) = 6.03 Or (cell.Value) = 3.04 Or (cell.Value) = 6.27 Then
Else
'## The following line makes no sense but i wrote it so you understand what i want to do
cell.Copy Destination:=sht2.Range("A" & r)
sht2.Range("B" & r) = "Not a valid WP"
r = r + 1
End If
Next
End Sub
這是Andy和Santosh的代碼的更新代碼-
Sub test()
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Dim r As Long, lastr As Long
r = 3
Set sht1 = Sheets("DataSheet")
Set sht2 = Sheets("DiscrepancyReport")
With sht1
lastr = .Range("A" & .Rows.Count).End(xlUp).Row
If lastr < 3 Then lastr = 3
Set colrg = Range("A3:A" & lastr)
End With
For Each cell In colrg
If (cell.Value) <> 6.01 Or (cell.Value) <> 6.03 Or (cell.Value) <> 3.04 Or (cell.Value) <> 6.27 Then
'## The following line makes no sense but i wrote it so you understand what i want to do
sht2.Range("A" & r).value=Replace(cell.Address, "$", "")
'Comment the appropriate one below
'If you want this to be written in the 2nd sheet, below is the code, else comment it.
sht2.Range("B" & r) = "Not a valid WP"
'If you want this to be written in the 1st sheet, below is the code, else comment it.
cell.offset(0,1).value = "Not a valid WP"
r = r + 1
End If
Next
End Sub
希望這可以幫助。
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.