请帮我为这个 vba 代码创建一个循环

Question

我有 2 张表，sourcesheet 和 acct 表。从 sourceSheet 我需要将值从 sourceSheet.Range(Cells(14, 3),Cells(14, 8)) 复制到 AcctSheet.range(Cells(2, 11),Cells(7, 11))，但是每个sourcesheet 中的单元格与 acctsheet 完全匹配，因此

sourceSheet.Cells(14, 3) = AcctSheet.Cells(2, 11)
sourceSheet.Cells(14, 4) = AcctSheet.Cells(3, 11)
sourceSheet.Cells(14, 5) = AcctSheet.Cells(4, 11) and so on until
sourceSheet.Cells(14, 8) = AcctSheet.Cells(7, 11)

完整的代码在这里，但希望循环这个。

sourceSheet.Activate
    'EQ
    If IsEmpty(sourceSheet.Cells(14, 3).Value) Then
        AcctSheet.Cells(2, 11).Value = sourceSheet.Cells(7, 1).Value   
    ElseIf sourceSheet.Cells(14, 3).Value < sourceSheet.Cells(7, 1).Value Then
        AcctSheet.Cells(2, 11).Value = sourceSheet.Cells(14, 3).Value 
    ElseIf sourceSheet.Cells(14, 3).Value > sourceSheet.Cells(7, 1).Value Then
        AcctSheet.Cells(2, 11).Value = sourceSheet.Cells(7, 1).Value   
    End If
    'WS
    If IsEmpty(sourceSheet.Cells(14, 4).Value) Then
        AcctSheet.Cells(3, 11).Value = sourceSheet.Cells(7, 1).Value   
    ElseIf sourceSheet.Cells(14, 4).Value < sourceSheet.Cells(7, 1).Value Then
        AcctSheet.Cells(3, 11).Value = sourceSheet.Cells(14, 4).Value 
    ElseIf sourceSheet.Cells(14, 4).Value > sourceSheet.Cells(7, 1).Value Then
        AcctSheet.Cells(3, 11).Value = sourceSheet.Cells(7, 1).Value   
    End If
    'TO
    If IsEmpty(sourceSheet.Cells(14, 5).Value) Then
        AcctSheet.Cells(4, 11).Value = sourceSheet.Cells(7, 1).Value   
    ElseIf sourceSheet.Cells(14, 5).Value < sourceSheet.Cells(7, 1).Value Then
        AcctSheet.Cells(4, 11).Value = sourceSheet.Cells(14, 5).Value 
    ElseIf sourceSheet.Cells(14, 5).Value > sourceSheet.Cells(7, 1).Value Then
        AcctSheet.Cells(4, 11).Value = sourceSheet.Cells(7, 1).Value   
    End If
    'FL
    If IsEmpty(sourceSheet.Cells(14, 6).Value) Then
        AcctSheet.Cells(5, 11).Value = sourceSheet.Cells(7, 1).Value   
    ElseIf sourceSheet.Cells(14, 6).Value < sourceSheet.Cells(7, 1).Value Then
        AcctSheet.Cells(5, 11).Value = sourceSheet.Cells(14, 6).Value 
    ElseIf sourceSheet.Cells(14, 6).Value > sourceSheet.Cells(7, 1).Value Then
        AcctSheet.Cells(5, 11).Value = sourceSheet.Cells(7, 1).Value   
    End If
    'FR
    If IsEmpty(sourceSheet.Cells(14, 7).Value) Then
        AcctSheet.Cells(6, 11).Value = sourceSheet.Cells(7, 1).Value   
    ElseIf sourceSheet.Cells(14, 7).Value < sourceSheet.Cells(7, 1).Value Then
        AcctSheet.Cells(6, 11).Value = sourceSheet.Cells(14, 7).Value 
    ElseIf sourceSheet.Cells(14, 7).Value > sourceSheet.Cells(7, 1).Value Then
        AcctSheet.Cells(6, 11).Value = sourceSheet.Cells(7, 1).Value   
    End If
    'TR
    If IsEmpty(sourceSheet.Cells(14, 8).Value) Then
        AcctSheet.Cells(7, 11).Value = sourceSheet.Cells(7, 1).Value   
    ElseIf sourceSheet.Cells(14, 8).Value < sourceSheet.Cells(7, 1).Value Then
        AcctSheet.Cells(7, 11).Value = sourceSheet.Cells(14, 8).Value 
    ElseIf sourceSheet.Cells(14, 8).Value > sourceSheet.Cells(7, 1).Value Then
        AcctSheet.Cells(7, 11).Value = sourceSheet.Cells(7, 1).Value   
    End If

Answer 1

您正在寻找类似的东西吗？

Option Explicit

Sub test()
    Dim sourceSheet As Worksheet, acctSheet As Worksheet
    Dim i As Long
    Dim sourceCell As Range, targetCell As Range, defaultCell As Range
    
    Set defaultCell = sourceSheet.Cells(7, 1)
    
    For i = 3 To 8
    
        Set sourceCell = sourceSheet.Cells(14, i)
        Set targetCell = acctSheet.Cells(i - 1, 11)
        
        If IsEmpty(sourceCell) Then
            targetCell.Value2 = sourceCell.Value2
        ElseIf sourceCell.Value2 < defaultCell.Value2 Then
            targetCell.Value2 = sourceCell.Value2
        ElseIf sourceCell.Value2 > defaultCell.Value2 Then
            targetCell.Value2 = defaultCell.Value2
        End If
        
    Next i
    
End Sub

严格来说，我认为您不需要在每个单元格之后包含 .Value2，因为 VBA 在阅读代码时会使用它作为默认值，但这并没有什么坏处。

对单元格引用使用变量也不是绝对必要的，但我发现它更容易，尤其是当我需要稍后编辑单元格引用时。