Рецепт

Пересчитать AED в доллары в оборотке

В колонке валюты AED и USD вперемешку, в H нужна одна сумма в долларах и итог по блоку.

Строка опознаётся по колонке A: AED — F делите на курс, USD — копируйте F в H, ИТОГО — сумма всех уже посчитанных H выше этой строки. Остальные строки очищайте в H, чтобы старые цифры не всплыли. Курс лучше вынести в константу или на служебный лист. Цикл по ячейкам здесь уместен: ветвление по типу строки важнее скорости. После работы верните Calculation и ScreenUpdating, иначе книга «замирает».

Код

Sub ConnectAEDtoDoll()
    Dim ws As Worksheet
    Dim lastRow As Long, i As Long, j As Long
    Dim valueF As Double, sumH As Double, tempSum As Double
    Dim cellA As String
    Dim aedCount As Long, usdCount As Long, totalCount As Long
    Const EXCHANGE_RATE As Double = 3.653

    Set ws = ActiveSheet
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    For i = 1 To lastRow
        cellA = Trim$(CStr(ws.Cells(i, "A").Value))
        Select Case UCase$(cellA)
            Case "AED"
                If IsNumeric(ws.Cells(i, "F").Value) Then
                    valueF = CDbl(ws.Cells(i, "F").Value)
                    ws.Cells(i, "H").Value = valueF / EXCHANGE_RATE
                    ws.Cells(i, "H").NumberFormat = "#,##0.00"
                    sumH = sumH + ws.Cells(i, "H").Value
                    aedCount = aedCount + 1
                Else
                    ws.Cells(i, "H").Value = ""
                End If
            Case "USD"
                If IsNumeric(ws.Cells(i, "F").Value) Then
                    valueF = CDbl(ws.Cells(i, "F").Value)
                    ws.Cells(i, "H").Value = valueF
                    ws.Cells(i, "H").NumberFormat = "#,##0.00"
                    sumH = sumH + ws.Cells(i, "H").Value
                    usdCount = usdCount + 1
                Else
                    ws.Cells(i, "H").Value = ""
                End If
            Case "ИТОГО"
                tempSum = 0
                For j = 1 To i - 1
                    If IsNumeric(ws.Cells(j, "H").Value) Then
                        tempSum = tempSum + CDbl(ws.Cells(j, "H").Value)
                    End If
                Next j
                ws.Cells(i, "H").Value = tempSum
                ws.Cells(i, "H").NumberFormat = "#,##0.00"
                ws.Cells(i, "H").Font.Bold = True
                ws.Cells(i, "H").Interior.Color = RGB(200, 230, 200)
                totalCount = totalCount + 1
            Case Else
                ws.Cells(i, "H").ClearContents
        End Select
    Next i

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    ws.Columns("H").AutoFit
    MsgBox "Обработано AED: " & aedCount & vbCrLf & _
           "USD: " & usdCount & vbCrLf & _
           "Строк ИТОГО: " & totalCount & vbCrLf & _
           "Сумма H без итогов: " & Format(sumH, "#,##0.00"), vbInformation
End Sub

Связанные члены API