У меня есть 2 листа, исходный лист и акцентный лист. Из sourceSheet мне нужно скопировать значения из sourceSheet.Range (Cells (14, 3), Cells (14, 8)) в AcctSheet.range (Cells (2, 11), Cells (7, 11)), однако каждый ячейка из таблицы источников отличается от таблицы документов таким образом, что

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
0
Jvargas 24 Ноя 2021 в 15:33
1
У вас есть < и >, но ничего, если =, это предназначено?
 – 
CDP1802
24 Ноя 2021 в 16:00

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 вроде как использует это по умолчанию при чтении кода, но это не повредит.

Использование переменных для ссылок на ячейки также не является строго необходимым, но мне это кажется проще, особенно если мне нужно отредактировать ссылки на ячейки позже.

1
CDP1802 24 Ноя 2021 в 15:57
О мой Бог! благодарю вас! это отвечает на мою проблему!
 – 
Jvargas
24 Ноя 2021 в 16:24