excel 每隔一行乘以1.05

2skhul33  于 2023-05-23  发布在  其他
关注(0)|答案(4)|浏览(152)

我试图创建一个VBA代码,每隔一行乘以1.05的行,没有空单元格在列M和这里是我想出了(这是从10开始)
但是,它返回类型不匹配错误。

Sub MultiplyEverySecondRow()
    Dim lastRow As Long
    Dim i As Long

    lastRow = Cells(Rows.Count, "M").End(xlUp).Row
    For i = 11 To lastRow Step 2
        Range("Q" & i & ":BC" & i).Value = Range("Q" & i & ":BC" & i).Value * 1.05
    Next i
End Sub
exdqitrt

exdqitrt1#

使用数组进行操作并将其写回工作表将快得多:

Sub MultiplyEverySecondRow()
    
    Const factor As Single = 1.05
    
    Dim ws As Worksheet
    Set ws = ActiveSheet    '--> adjust this to your needs
    
    
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, "M").End(xlUp).Row
    
    Dim rgData As Range
    Set rgData = ws.Range("Q11:BC" & lastRow)
    
    Dim arrData As Variant, iRow As Long, iColumn As Long
    arrData = rgData.Value
    
    For iRow = 1 To UBound(arrData, 1) Step 2
        For iColumn = 1 To UBound(arrData, 2)
           arrData(iRow, iColumn) = arrData(iRow, iColumn) * factor
        Next
    Next
    
    rgData.Value = arrData
    
End Sub

此外,您应该避免隐式引用,因此我添加了变量ws

w41d8nur

w41d8nur2#

您希望乘以每个单元格值,而不是整个范围。看看下面的代码:

Sub MultiplyEverySecondRow()
    Dim lastRow As Long
    Dim i As Long
    
    lastRow = Cells(Rows.Count, "M").End(xlUp).Row
    For i = 11 To lastRow Step 2
        For Each c In Range("Q" & i & ":BC" & i)
            c.Value = c.Value * 1.05
        Next
    Next i
End Sub
yr9zkbsy

yr9zkbsy3#

如果Range是一个多单元格区域,则.Value返回一个二维数组。你不能用一个数字乘以整个数组。你必须遍历该范围内的所有单元格,并分别乘以每个单元格。
还要注意检查列M中的单元格是否不为空的条件。您还应该养成使用工作表限定所有范围的习惯(请参阅下面的With语句)。将Sheet2更改为正在处理的图纸的名称。
尝试以下操作:

Sub MultiplyEverySecondRow()
  Dim lastRow As Long
  Dim i As Long
  Dim cl As Range
  
  With ThisWorkbook.Sheets("Sheet2")
    lastRow = .Cells(Rows.Count, "M").End(xlUp).Row
    For i = 11 To lastRow Step 2
      If Not IsEmpty(.Cells(i, "M")) Then
        For Each cl In .Range("Q" & i & ":BC" & i).Cells
          cl.Value = cl.Value * 1.05
        Next cl
      End If
    Next i
  End With
End Sub
fhity93d

fhity93d4#

第N行相乘

数组

  • 循环遍历数组的元素比循环遍历范围的单元格要高效得多。
Option Explicit

Sub MultiplyNthRows()
    
    Const FIRST_CELL As String = "M11"
    Const SRC_COLUMNS As String = "Q:BC"
    Const Nth_ROW As Long = 2
    Const MULTIPLIER As Double = 1.05
    
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    
    Dim rg As Range, rCount As Long, cCount As Long
    
    With ws.Range(FIRST_CELL)
        rCount = ws.Cells(ws.Rows.Count, .Column).End(xlUp).Row - .Row + 1
        If rCount < 1 Then Exit Sub ' no data (tickers)
        Set rg = .Resize(rCount).EntireRow.Columns(SRC_COLUMNS)
        cCount = rg.Columns.Count
    End With
    
    Dim Data()
        
    If rCount = 1 Then
        ReDim Data(1 To 1, 1 To 1): Data(1, 1) = rg.Value
    Else
        Data = rg.Value
    End If
    
    Dim Value, r As Long, c As Long
    
    For r = 1 To rCount Step Nth_ROW
        For c = 1 To cCount
            Value = Data(r, c)
            If VarType(Value) = vbDouble Then ' is a number
                Data(r, c) = Value * MULTIPLIER
            End If
        Next c
    Next r
    
    rg.Value = Data
    
End Sub

评估

  • 发生错误是因为您无法以尝试执行的方式将数组与数字相乘,这与您在Excel中执行的方式类似。但是你可以使用Evaluate来实现:
Range("Q" & i & ":BC" & i).Value = Evaluate(Range("Q" & i & ":BC" & i).Address & "*1.05")
  • 引入With语句将使其更具可读性:
With Range("Q" & i & ":BC" & i)
    .Value = Evaluate(.Address & "*1.05")
End With
Sub MultiplyNthRowsEvaluate()
    
    Const FIRST_CELL As String = "M11"
    Const SRC_COLUMNS As String = "Q:BC"
    Const Nth_ROW As Long = 2
    Const MULTIPLIER As String = "1.05"
    
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    
    Dim rg As Range, rCount As Long
    
    With ws.Range(FIRST_CELL)
        rCount = ws.Cells(ws.Rows.Count, .Column).End(xlUp).Row - .Row + 1
        If rCount < 1 Then Exit Sub ' no data (tickers)
        Set rg = .Resize(rCount).EntireRow.Columns(SRC_COLUMNS)
    End With
    
    Dim rrg As Range, r As Long
    
    For Each rrg In rg.Rows
        r = r + 1
        If r Mod Nth_ROW = 1 Then
            rrg.Value = ws.Evaluate(rrg.Address & "*" & MULTIPLIER)
        End If
    Next rrg
    
End Sub

相关问题