如果要计算else语句,复制并粘贴吗?

时间:2019-04-30 02:44:21

标签: excel vba

我有一些现有的代码可以查看多列并将数据从一个选项卡复制到另一选项卡,但是我需要输入额外的代码,该代码会重新计算这些列之一,然后再将其粘贴到新选项卡中。我在四处搜寻帮助,但收效甚微。

总而言之,我需要VBA代码,该代码可在Excel中搜索一列,根据其发现重新计算另一列中的值,然后在完成后将值范围复制并粘贴到新的工作表中。

为了说明...

工作表1:

  • A列具有一系列美元价值
  • B列中包含X或Y的代码

我需要有效说明以下内容的代码:

If column B = X  
Then multiply value in Column A* 2  
Else leave as is  

然后将A列复制到工作表2的C列(或此时的任何列)

我曾尝试自己编写代码,但我仍然是一个初学者并且很挣扎。希望这有道理!

1 个答案:

答案 0 :(得分:0)

您可以尝试:

Option Explicit

Sub TEST()

    Dim LastRow1 As Long, i As Long, LastRow2 As Long
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim Amount As Double

    'Set worksheets
    With ThisWorkbook

        Set ws1 = .Worksheets("Sheet1")
        Set ws2 = .Worksheets("Sheet2")

    End With

    'Find Last row of sheet 1 column A
    LastRow1 = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row

    'Start looping rows from row 1 to lastrow1
    For i = 1 To LastRow1

        'If the value if X or Y
        If ws1.Range("B" & i).Value = "X" Then
            Amount = ws1.Range("A" & i).Value * 2
        Else
            Amount = ws1.Range("A" & i).Value
        End If

    'Find Last row of sheet 2 column C
    LastRow2 = ws2.Cells(ws2.Rows.Count, "C").End(xlUp).Row

    'Copy data
    ws2.Range("C" & LastRow2 + 1).Value = Amount

    Next i

End Sub