Question

我的数据集列是H到BQ，有3000行。我的列H在某些行中具有值，而在其他行中没有值。首先，我试图找到有价值的行。一旦我这样做，我想将该值除以第一列中的相应值以得到答案X.最后，我想重复第I列中的值 - 在该行的末尾有X值，有任何值

例如：

Row Number  Column H    Column I    Column J    Column K    Column L    
   1                                    
   2          1400        200        300            200        200              
   3                                    
   4          2000        1000                          
   5           400

预期结果：

第2行： 1400/200 = 7.我想在Column I

后7次重复Column L（200）中的值

第4行， 2000/1000 = 2.我想从Column I

开始2次重复Column J（1000）中的值

第5行 400/0 = 错误。在这种情况下，在Column H中重复Column I（400）中的值。

Answer 1

这应符合您的要求：

Sub DoThisThing()
Dim rCell As Range, OrCell As Range, startCol As Integer, dividingIntger As Integer, _
answer As Double, searchRng As Range, WS As Worksheet

Set WS = Sheets(ActiveSheet.Name) 'Or use actual sheet name i.e. Set WS = Sheets("Sheet1")
Set searchRng = WS.Range("H1:H3000") 'sets the range to search through.

For Each rCell In searchRng.Cells

    'If Column H is a numeric value, but not empty
    If IsNumeric(rCell) And Not IsEmpty(rCell) Then

        'Establishes offset cell being used
        Set OrCell = rCell.Offset(0, 1)

        'If column I has a numeric value that's not zero or blank
        If IsNumeric(OrCell) And OrCell.Value2 <> 0 Then

            'Number of columns to offset (rounded up)
            dividingIntger = Application.WorksheetFunction.RoundUp(rCell.Value2 / OrCell.Value2, 0)

            'Exact answer (decimals okay)
            answer = rCell.Value2 / dividingIntger

            'Finds which column to start entering values
            startCol = WS.Cells(rCell.Row, Columns.Count).End(xlToLeft).Column + 1

            'sets answer value into the starting column and over (less 1)
            Range(WS.Cells(rCell.Row, startCol), WS.Cells(rCell.Row, startCol).Offset(0, dividingIntger - 1)).Value2 = answer

        'If column I is zero or blank
        ElseIf IsNumeric(OrCell) Then

            'Sets Column I = to Column H
            OrCell.Value2 = rCell.Value2

        End If

    End If

Next rCell

End Sub
 '☠☠☠☠system tested!☄⚡✨

使用值在行尾插入计算值

1 个答案: