提问人：Stelios 提问时间：10/23/2023 最后编辑：JohnMStelios 更新时间：10/23/2023 访问量：49
复制与条件匹配的可见行并乘以百分比，然后粘贴到另一张工作表的最后一行
Copy visible rows that matches criteria and multiply by percentage then paste to another sheet's last row
问：
只有当我删除标准时，我才能成功执行上述主题。但是一旦我把它放回去，它就不会执行或什么都不做。以下是我的代码和标准。我想知道我将如何包含标准并保持此代码正常工作。我需要 A 列中与 DB2 工作表中的单元格 B2 匹配的所有行，然后复制到 DB3 工作表的最后一行。感谢任何帮助。
Sub VisibleRowsAndMultiplyByPercentage()
Dim wsSource As Worksheet
Dim wsDestination As Worksheet
Dim lastRowSource As Long, lastRowDest As Long
Dim criteria As Variant
Dim i As Long, j As Long
' Set source and destination worksheets
Set wsSource = ThisWorkbook.Sheets("DB2")
Set wsDestination = ThisWorkbook.Sheets("DB3")
' Get the criteria value from cell B2 in destination sheet (Sheet5)
criteria = wsSource.Range("B2").Value
' Find the last row in source sheet
lastRowSource = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
' Find the last row in destination sheet column A
lastRowDest = wsDestination.Cells(wsDestination.Rows.Count, "A").End(xlUp).Row + 1
' Loop through each row in column A of the source sheet
For i = 3 To lastRowSource
' Check if the row is visible and column A matches the criteria (B2 value)
If Not wsSource.Rows(i).Hidden And wsSource.Cells(i, 1).Value = criteria Then
' Copy values from column 1 to 10
For j = 1 To 10
wsDestination.Cells(lastRowDest, 1).Resize(, 10).Value = wsSource.Cells(i, 1).Resize(, 10).Value
Next j
' Loop through columns 11 to 22 in the source row, multiply by percentage, and copy to destination sheet
For j = 11 To 22
' Multiply the value by the corresponding percentage from row 1
Dim multipliedValue As Double
multipliedValue = wsSource.Cells(i, j).Value * wsSource.Cells(1, j).Value
' Copy the multiplied value to destination sheet
wsDestination.Cells(lastRowDest, j).Value = multipliedValue
Next j
' Move to the next row in destination sheet
lastRowDest = lastRowDest + 1
End If
Next i
End Sub
答：
0赞
Notus_Panda
10/23/2023
#1
这是您的代码根据我在评论中提到的内容进行了调整：
Sub VisibleRowsAndMultiplyByPercentage()
Dim wsSource As Worksheet
Dim wsDestination As Worksheet
Dim lastRowSource As Long, lastRowDest As Long
Dim criteria As Variant
Dim i As Long, j As Long
' Set source and destination worksheets
Set wsSource = ThisWorkbook.Sheets("DB2")
Set wsDestination = ThisWorkbook.Sheets("DB3")
' Get the criteria value from cell B2 in destination sheet (Sheet5)
criteria = wsSource.Range("B2").Value
' Find the last row in source sheet
lastRowSource = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
' Find the last row in destination sheet column A
lastRowDest = wsDestination.Cells(wsDestination.Rows.Count, "A").End(xlUp).Row + 1
Dim arrPrint
Dim multipliedValue As Double
ReDim arrPrint(1 To 12)
' Loop through each row in column A of the source sheet
For i = 3 To lastRowSource
' Check if the row is visible and column A matches the criteria (B2 value)
If Not wsSource.Rows(i).Hidden And wsSource.Cells(i, 1).Value = criteria Then
' Copy values from column 1 to 10
wsDestination.Cells(lastRowDest, 1).Resize(, 10).Value = wsSource.Cells(i, 1).Resize(, 10).Value
' Loop through columns 11 to 22 in the source row, multiply by percentage, and copy to destination sheet
For j = 11 To 22
' Multiply the value by the corresponding percentage from row 1
arrPrint(j - 10) = wsSource.Cells(i, j).Value * wsSource.Cells(1, j).Value
Next j
' Copy the multiplied value to destination sheet
wsDestination.Cells(lastRowDest, 11).Resize(, UBound(arrPrint)).Value = arrPrint
' Move to the next row in destination sheet
lastRowDest = lastRowDest + 1
End If
Next i
End Sub
用于防止未声明的变量（和其他此类问题）导致问题;请参阅此如何在将来的所有代码中自动设置它。Option Explicit
评论
criteriaSpecialCells(xlCellTypeVisible)Dim criteria As StringwsDestination.Cells(lastRowDest, 1).Resize(,10).Value = wsSource.Cells(i, 1).Resize(,10).Valuefor j = 1 To 10