Привет если кто то знает может пожалуйста подсказать как сделать реестр на данном файле. уточню: мне надо сделать так чтобы после использования кнопки "ÇAP" в зависимости от операции данные записались в SHEET2 в соответствующие ячейки последовательно. *заранее спасибо всем!!))
Здарова. А заполните вручную таблицу на листе SHEET2 данными с листа SHEET1, чтобы чётче понимать желаемый результат. Это первое. 2) Таблица на листе SHEET2 фиксированная или предполагается её расширение вниз? 3) Если можно, то сделайте в файле-примере надписи на местном языке можно и транслитом. Спасибо. +++ И имя файла на латинице, пожалуйста.
BEHBUDOV_7, Вы готовы сменить принцип фиксации данных на иной? Как я вижу - это обычная плоская таблица, где будут поля: дата события, вид операции, валюта, курс, сумма.
Формула массива (ФМ) вводится Ctrl+Shift+Enter Memento mori
ДА да так точно это обычная плоская таблица, где будут поля: дата события, вид операции, валюта, курс, сумма.)) мне надо на основе моей таблицы образовался плоская таблица, где будут поля: дата события, вид операции, валюта, курс, сумма - соответственно
Option Explicit
Sub data_to_base()
Const lFIELD_DATE_EVENT As Long = 1 ' дата события
Const lFIELD_OPERATION_TYPE As Long = 2 ' вид операции
Const lFIELD_CURRENCY As Long = 3 ' валюта
Const lFIELD_RATE As Long = 4 ' курс
Const lFIELD_SUM As Long = 5 ' сумма
Const lCOL_OPERATION_BY As Long = 3 ' вид операции - покупка
Const lCOL_OPERATION_SALE As Long = 4 ' вид операции - продажа
Const lCOL_RATE_BY As Long = 6 ' курс - покупка
Const lCOL_RATE_SALE As Long = 8 ' курс - продажа
Dim obj, arr(1 To 1, 1 To 5), lOperationCol As Long
arr(1, lFIELD_DATE_EVENT) = Now
For Each obj In Me.DrawingObjects
If StrComp(TypeName(obj), "OptionButton", vbTextCompare) = 0 Then
If obj.Value = 1 Then
arr(1, lFIELD_DATE_EVENT) = Now
With obj.TopLeftCell
lOperationCol = .Column
arr(1, lFIELD_OPERATION_TYPE) = Me.Cells(5, lOperationCol).Value
arr(1, lFIELD_CURRENCY) = Me.Cells(.Row, "E").Value
Select Case lOperationCol
Case lCOL_OPERATION_BY: arr(1, lFIELD_RATE) = Me.Cells(.Row, lCOL_RATE_BY).Value
Case lCOL_OPERATION_SALE: arr(1, lFIELD_RATE) = Me.Cells(.Row, lCOL_RATE_SALE).Value
End Select
arr(1, lFIELD_SUM) = Me.Range("C11").Value
End With ' obj.TopLeftCell
With [base]
With .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(, UBound(arr, 2))
.Value = arr
End With ' .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(, UBound(arr, 2))
End With ' [base]
Exit For
End If
End If
Next obj
Me.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
End Sub
+++ Макрос содержит ошибку - берётся только один курс. Исправляю... +++ Исправил. Тестируйте.