我有一個包含銷售資料的作業表，我已經設法根據部門創建自動過濾器并將結果復制到新作業表（輸出）中。我想要實作的是代碼會將各個月份的結果乘以“調整”行中的值。
所以結果如下
有沒有辦法在我的代碼中處理計算，或者我之后將不同 Sub 中的每一列相乘？
Dim Last_Row As Long
Dim DbExtract, DuplicateRecords As Worksheet
Dim WKS2 As Worksheet
Dim rn As Range
Set DbExtract = ThisWorkbook.Sheets("Data")
Set DuplicateRecords = ThisWorkbook.Sheets("Output")
Set WKS2 = ThisWorkbook.Sheets("Dashboard")
iMultiplier = WKS2.Range("Z18")
Application.ScreenUpdating = False
Last_Row = DuplicateRecords.Range("A" & Rows.Count).End(xlUp).Row 1
DbExtract.Range("C3:R1500").SpecialCells(xlCellTypeVisible).Copy
DuplicateRecords.Range("A" & Last_Row).PasteSpecial
DuplicateRecords.Range("$A$1:$P$400").AutoFilter Field:=3, Criteria1:=WKS2.Range("V2")
Set rn = DuplicateRecords.Range("G2:G500").SpecialCells(xlCellTypeVisible)
For Each cell In rn
iNewnumber = cell * iMultiplier
Next cell
End Sub
uj5u.com熱心網友回復：
這是一個例子：
Sub Tester()
Dim lastRow As Long, wb As Workbook
Dim wsData As Worksheet, wsOutput As Worksheet
Dim wsDash As Worksheet, rngVis As Range, numVisRows As Long
Dim rn As Range, rngAdj As Range, m As Long, adj, c As Range
Set wb = ThisWorkbook
Set wsData = wb.Sheets("Data") 'consistent naming helps...
Set wsOutput = wb.Sheets("Output")
Set wsDash = wb.Sheets("Dashboard")
'iMultiplier = wsDash.Range("Z18") '?
Application.ScreenUpdating = False
Set rngVis = wsData.Range("C3:R1500").SpecialCells(xlCellTypeVisible)
numVisRows = rngVis.Cells.Count / rngVis.Columns.Count
rngVis.Copy
lastRow = wsOutput.Range("A" & Rows.Count).End(xlUp).Row 1 'start of pasted data
wsOutput.Range("A" & lastRow).PasteSpecial
Set rngAdj = wsDash.Range("C5:N5") 'for example
For m = 1 To rngAdj.Columns.Count 'loop the cells in the adjustments range
adj = rngAdj.Cells(m).Value 'adjustment value
If Len(adj) > 0 And IsNumeric(adj) Then 'have an adjustment to make?
'loop the relevant cells in the pasted data
For Each c In wsOutput.Cells(lastRow, "A").Offset(0, 2 m).Resize(numVisRows).Cells
If Len(c.Value) > 0 And IsNumeric(c.Value) Then 'any thing to adjust?
c.Value = c.Value * adj
End If
Next c
End If
Next m
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/shujuku/442148.html