Question

对编码VBA不是很有经验，但我很感激任何帮助。下面的代码运行正常;但从逻辑上讲，我觉得它写得更好。有人有建议吗？

Sub CopyValues()

  'Declare variables
   Dim Sourcedataws As Worksheet
   Dim WStotransfer As Worksheet

  'Declare counter variables
   Dim i As Integer
   Dim lastrow As Long

  'Declare sheet variables
   Set Sourcedataws = ThisWorkbook.Sheets("Source Data")
   Set WStotransferws = ThisWorkbook.Sheets("WStotransfer")

    lastrow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

  For i = 2 To lastrow

If Sourcedataws.Range("AA" & i).Value = "Condition" Then

    WStotransferws.Range("C18") = Sourcedataws.Range("A" & i).Value
    ActiveCell.Offset(0, 1).Select
    WStotransferws.Range("D18") = Sourcedataws.Range("A" & i).Value
    ActiveCell.Offset(0, 1).Select
    WStotransferws.Range("E18") = Sourcedataws.Range("A" & i).Value
    ActiveCell.Offset(0, 1).Select
    WStotransferws.Range("F18") = Sourcedataws.Range("A" & i).Value
    ActiveCell.Offset(0, 1).Select
    WStotransferws.Range("G18") = Sourcedataws.Range("A" & i).Value
    ActiveCell.Offset(0, 1).Select
    WStotransferws.Range("H18") = Sourcedataws.Range("A" & i).Value
    ActiveCell.Offset(0, 1).Select
    WStotransferws.Range("I18") = Sourcedataws.Range("A" & i).Value



End If

Next

End Sub

Answer 1

尝试：

Sub CopyValues()

'Declare counter variables
Dim i As Integer, j as Integer, lastrow As Long
'Declare variables
Dim Sourcedataws As Worksheet, WStotransfer As Worksheet
'Declare sheet variables
Set Sourcedataws = ThisWorkbook.Sheets("Source Data")
Set WStotransferws = ThisWorkbook.Sheets("WStotransfer")

lastrow = Sourcedataws.Cells(Sourcedataws.Rows.Count, "A").End(xlUp).Row

WStotransferws.Range("C18:I18").ClearContents

For i = 2 To lastrow
    If WStotransferws.Range("I18").Value="" Then
        If Sourcedataws.Range("AA" & i).Value = "Condition" Then
            Sourcedataws.Range("A"&i).Copy 
            j=WStotransferws.Cells(18, WStotransferws.Columns.Count).End(xlToLeft).Column
            WStotransferws.Cells(18,j+1).PasteSpecial xlPasteValues
            End If
        Else
        End If
    Next i

End Sub

VBA需要一个嵌套循环来移动列

1 个答案: