[решено] [Excel] Присвоение значения ячейке - Компьютерный форум OSzone.net

Компьютерный форум OSzone.net (http://forum.oszone.net/index.php)

- Программирование и базы данных (http://forum.oszone.net/forumdisplay.php?f=21)

- - [решено] [Excel] Присвоение значения ячейке (http://forum.oszone.net/showthread.php?t=229911)

[Excel] Присвоение значения ячейке

Добрый день!
Необходимо в определенные ячеки листа внести определенные формулы из скрипта.
Делаю так:

Код:

    Dim sheetWithKvit As Worksheet

    Set sheetWithKvit = Worksheets("Лист1")



    Do While True ' Not IsNull(Sheets("Лист2").Range("A" + Str(curRow)))

        text = "=Лист2!G" + Str(curRow)

        sheetWithKvit.Cells(curRowInKvit, curCollumnInKvit).Value = text

На последней приведенной строке возникает 1004 ошибка "Application-defined or object-defined error". Пробовал разные вариации на тему, но получается та же ошибка.
Как реализовать банальнейшее присвоение значения ячейке???

Понимаю, что задача банальна, но как ни смешно, не могу понять как это закодировать.

Цитата:

Цитата PhilB

На последней приведенной строке возникает 1004 ошибка "Application-defined or object-defined error". Пробовал разные вариации на тему, но получается та же ошибка. »

PhilB, недостаточно приведённых данных для ответа.

Цитата:

Цитата PhilB

Как реализовать банальнейшее присвоение значения ячейке??? »

Именно так, как у Вас написано. Но Вы хотите присвоить ячейке не значение, а формулу. Соответственно, Вы должны использовать не свойство «.Value», а свойства .Formula/.FormulaLocal или .FormulaR1C1/.FormulaR1C1Local.

Using Microsoft Excel Worksheet Functions in Visual Basic [Excel 2003 VBA Language Reference]:

Цитата:

…
Inserting a Worksheet Function into a Cell

To insert a worksheet function into a cell, you specify the function as the value of the Formula property of the corresponding Range object. In the following example, the RAND worksheet function (which generates a random number) is assigned to the Formula property of range A1:B3 on Sheet1 in the active workbook.

Код:

Sub InsertFormula()

    Worksheets("Sheet1").Range("A1:B3").Formula = "=RAND()"

End Sub

Так работает:

Код:

Worksheets("Лист1").Cells(curRowInKvit, curCollumnInKvit).FormulaR1C1 = "=Лист2!G"

Так не работает (а хотелось бы :)):

Код:

Worksheets("Лист1").Cells(curRowInKvit, curCollumnInKvit).FormulaR1C1 = "=Лист2!G" + Str(curRow)

Вариант с .Formula тоже пробовал. Проблема та же.

Суть задачи в том, что необходимость реализовать именно динамическую сборку формул. Но не могу понять как.

P.S. Это реализуется мной в Office 2003

PhilB, я уже говорил выше:

Цитата:

Цитата Iska

…недостаточно приведённых данных для ответа. »

Приведите весь код.

Суть задачи:
Есть view в БД MS Access. И шаблон квитанции в Excel. Суть задачи: получить данные из БД, и не основе шаблона сгенерировать квитанции, подставив туда соответсвующие данные. То есть получается по сути операция типа слияние в word. В excel подобного я не нашел, посему пишу скрипт.
Весь код:

Код:

Sub Макрос2()



    ' Скопировать лист

    Sheets("Лист1").Copy



    ' Костыль: вручную скопировать одну из ячеек, т.к. ее длина превышает 255 символов

    Windows("Квитанция ШАБЛОН.xls").Activate

    Range("B6").Select

    Selection.Copy

    

    ' Костыль: вручную вставить одну из ячеек, т.к. ее длина превышает 255 символов

    Windows(Windows.Count).Activate

    Range("B6").Select

    ActiveSheet.Paste

    Range("D6").Select

    ActiveSheet.Paste

    Range("D12").Select

    ActiveSheet.Paste

    Range("B12").Select

    ActiveSheet.Paste

    

    ' Добавить источник данных

    Sheets.Add

    Application.CutCopyMode = False

    With ActiveSheet.QueryTables.Add(Connection:=Array( _

        "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=X:\Work\Юлька\Клиенты.mdb;Mode=Read;Extended Properties=""" _

        , _

        """;Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Engine Type=5;Jet OLEDB:Datab" _

        , _

        "ase Locking Mode=1;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Password="""";J" _

        , _

        "et OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on Compact=False;Jet OLEDB:Co" _

        , "mpact Without Replica Repair=False;Jet OLEDB:SFP=False"), Destination:= _

        Range("A1"))

        .CommandType = xlCmdTable

        .CommandText = Array("Квитанция")

        .Name = "Клиенты"

        .FieldNames = True

        .RowNumbers = False

        .FillAdjacentFormulas = False

        .PreserveFormatting = True

        .RefreshOnFileOpen = False

        .BackgroundQuery = True

        .RefreshStyle = xlInsertDeleteCells

        .SavePassword = False

        .SaveData = True

        .AdjustColumnWidth = True

        .RefreshPeriod = 0

        .PreserveColumnInfo = True

        .SourceDataFile = "X:\Work\Юлька\Клиенты.mdb"

        .Refresh BackgroundQuery:=False

    End With

    

    ' Подготовка к вставке ссылок листа с квитанциями на ячейки с данными

    'Sheets("Лист1").Select

    

    Dim text As String

    

    Dim collumnsInKvit As Integer

    collumnsInKvit = 17

    

    Dim kvitNum As Integer

    kvitNum = 1

    

    Dim curRow As Integer

    curRow = 2

    

    Dim curRowInKvit As Integer

    curRowInKvit = 2

    Dim curCollumnInKvit As Integer

    curCollumnInKvit = 1 ' "A"

    Dim curSecondCollumnInKvit As Integer

    curSecondCollumnInKvit = 2 ' "B"

    

    Dim sheetWithKvit As Worksheet

    Set sheetWithKvit = Worksheets("Лист1")



    Do While IsNull(Worksheets("Лист1").Range("A" + Str(curRow)))

        ' Sheets("Лист1").Select

        'Sheets("Лист1").Activate

                

        ' Платеж

        Dim a As Object

        Worksheets("Лист1").Cells(curRowInKvit, curCollumnInKvit).FormulaR1C1 = "=Лист2!G" + Str(curRow)

        

        ' Долг

        text = "=Лист2!H" + Str(curRow)

        Range(curSecondCollumnInKvit + Str(curRowInKvit)).Value = text

        

        ' Адрес

        text = "=Лист2!C" + Str(curRow)

        Range(curSecondCollumnInKvit + Str(curRowInKvit + 1)).Value = text

        

        ' Код плательщика

        text = "=Лист2!F" + Str(curRow)

        Range(curCollumnInKvit + Str(curRowInKvit + 2)).Value = text

        

        ' ФИО

        text = "=Лист2!D" + Str(curRow)

        Range(curSecondCollumnInKvit + Str(curRowInKvit + 2)).Value = text

        

        ' Добавление страницы

        If kvitNum Mod 2 = 0 Then

            Range("A" + Str(curRowInKvit) + ":D" + Str(curRowInKvit + collumnsInKvit)).Copy

            Range("A" + Str(curRowInKvit + collumnsInKvit)).Select

            ActiveSheet.Paste

            ActiveSheet.PageSetup.PrintArea = "$A$1:$D$" + Str(curRowInKvit + collumnsInKvit)

        End If

        

        ' Переход к следующей квитанции

        If kvitNum Mod 2 = 1 Then

            curCollumnInKvit = 3 '"C"

            curSecondCollumnInKvit = 4 '"D"

        Else

            curCollumnInKvit = 1 ' "A"

            curSecondCollumnInKvit = 2 '"B"

        End If

        curRowInKvit = curRowInKvit + collumnsInKvit

        curRow = curRow + 1

        

        ' Sheets("Лист2").Select

        Sheets("Лист2").Activate

                        

    Loop



End Sub

]
Лист копирую, т.к. при копировании диапазона, почему-то не сохраняется форматирование. Вообще, оно какое-то мутное. Видимо, надо и книгу указывать, а не только лист, но она создается кодом Sheets("Лист1").Copy, и как получить имя книги не ясно.
Толковой книги так и не нашел :(. Натолкните на ошибку, пожалуста.
Iska, спасибо за внимание.

К сожалению, чтобы воспроизвести ошибку — мне понадобятся все Ваши данные. Так что, сие, скорее всего, отпадает.

Цитата:

Цитата PhilB

Так не работает (а хотелось бы ):

Код:

Worksheets("Лист1").Cells(curRowInKvit, curCollumnInKvit).FormulaR1C1 = "=Лист2!G" + Str(curRow)

«.FormulaR1C1()» предусматривает задание адреса в стиле «R1C1», наподобие «=Лист2!R[7]C[1]».

Цитата:

Цитата PhilB

Вариант с .Formula тоже пробовал. Проблема та же. »

Попробуйте данную строку ещё в таком виде:

Код:

Worksheets("Лист1").Cells(curRowInKvit, curCollumnInKvit).Formula = "=Лист2!G" & СStr(curRow)

Да, после замены фукнции Str на CStr все заработало как надо.
Следующая конструкция оказалась рабочей:

Код:

Cells(curRowInKvit, curCollumnInKvit).Formula = "=Лист2!G" + СStr(curRow)

Iska, благодарю за помощь!

PhilB, напомню ещё, на всякий случай, про разницу в свойствах «.Formula»/«.FormulaLocal»: если у Вас локализованная версия, и Вы будете использовать в ячейках формулы рабочего листа (например, «СУММ()»/«SUM()»), то свойство «.Formula» ожидает увидеть в текстовой строке присвоения свойства англоязычные наименования формул рабочего листа — например, «SUM()», а свойство «.FormulaLocal» — соответственно, локализованные наименования формул рабочего листа, в данном случае — «СУММ()».

Не могу снять сумму с массива данных, ибо некоторые из этих данных по условию ложны. Не могу дать нулевое значение ложной переменной.
Я, честное слово, не умею на вашем языке разговаривать.
Но, если я пытаюсь научить ячейку показывать ноль, при ложном значении, но, числовое значение, при истинном, то возникает цикличность, формула не работает. Это никак не обойти?

Евгений_Косьяненко@fb, выложите Вашу рабочую книгу. Укажите диапазон массива.

Доброго времени суток. Подскажите пожалуйста, есть такой код:

Код:

Imports System

Imports System.IO

Imports System.Text



Public Class Form1



    Dim Exc, CExc, CExcs, xlCenter, Selection As Object



    Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load

        Dim Exc As Object = CreateObject("Excel.Application")



        'Открыть новую книгу Excel

        CExc = Exc.Workbooks.Add

        CExcs = CExc.Worksheets(1)

        CExcs = CExc.Worksheets(1).Activate

        'CExcs = CExc.Worksheets(2).Delete

        'CExcs = CExc.Worksheets(3).Delete

        Exc.visible = True 'Видимость книги Эксель - False - Невидима и выполняется все в срытном режиме



        'Добавить данные в ячейки первого листа новой книги

        Exc.sheets(1).range("A1").value = "Таб. №"

        Exc.sheets(1).range("B1").value = "Ф.И.О."

        Exc.sheets(1).range("C1").value = "Должность"

        Exc.sheets(1).range("D1").value = "Логин"

        Exc.sheets(1).range("E1").value = "Пароль"

        Exc.sheets(1).range("A1:E1").Font.Bold = True

        Exc.sheets(1).range("A1:E1").Font.Size = 11

        Exc.sheets(1).range("A1:E1").Interior.ColorIndex = 6

        Exc.sheets(1).range("A1:E1").HorizontalAlignment = xlCenter

        Exc.sheets(1).range("A1:E1").VerticalAlignment = xlCenter

        Exc.sheets(1).range("A1:E1").WrapText = False

        Exc.sheets(1).range("A1:E1").Orientation = 0

        Exc.sheets(1).range("A1:E1").MergeCells = False



    End Sub



    Private Sub Commit_Click(sender As System.Object, e As System.EventArgs) Handles Commit.Click

        Exc.sheets(1).range("A2").value = Me.EIDText

        Exc.sheets(1).range("B2").value = Me.LFMText

        Exc.sheets(1).range("C2").value = Me.TitleText

        Exc.sheets(1).range("D2").value = Me.LoginText

        Exc.sheets(1).range("E2").value = Me.PwdText



        'Сохранить книгу и закрыть Excel

            CExc.SaveAs("C:\EmployeeList.xlsx")

            Exc.Quit()

    End Sub

End Class

Во-первых, почему не хочет заносится значения переменных Me.EIDText и т.д. в указанные ячейки? Хотя переменные заданы, при отладке данные в этих переменных есть. При отладке после выполнения Exc.sheets(1).range("A2").Text = Me.EIDText выдает сообщение: "Не задана переменная объекта или переменная блока With."
Во-вторых, где можно почитать про форматирование ячеек? Хотелось бы задать текст по центру, шрифт и.т.д.
В-третьих файл не *xlsx не сохраняется по указанному пути.
P.S. ссылку на Microsoft Office 14.0 Object Library делал... Но как ей воспользоваться - не знаю :(

P.S.S. С третьим вопросом разобрался.

Цитата:

Цитата Devils0411

Во-первых, почему »

Devils0411, покажите Ваш проект VB.Net. Чтобы можно было рассуждать предметно.

Цитата:

Цитата Devils0411

Во-вторых, где можно почитать про форматирование ячеек? Хотелось бы задать текст по центру, шрифт и.т.д. »

В справке Microsoft Office. В MSDN.

Цитата:

Цитата Devils0411

P.S. ссылку на Microsoft Office 14.0 Object Library делал... Но как ей воспользоваться - не знаю »

Вы ей уже пользуетесь:

Цитата:

Цитата Devils0411

xlCenter »

но местами.

Цитата:

Цитата Devils0411

Dim Exc As Object = CreateObject("Excel.Application") »

Теперь выдает следующую ошибку: Член группы не найден. (Исключение из HRESULT: 0x80020003 (DISP_E_MEMBERNOTFOUND)) в данной части кода Exc.sheets(1).range("A" & i).value = Me.EIDText
Сам код:

Код:

Imports System

Imports System.IO

Imports System.Text



Public Class Form1



    Dim CExc, CExcs, xlCenter As Object

    Dim Exc As Object = CreateObject("Excel.Application")



    Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load



        'Открыть новую книгу Excel

        CExc = Exc.Workbooks.Add(1)

        CExcs = CExc.Worksheets(1).Activate

        Exc.visible = True 'Видимость книги Эксель - False - Невидима и выполняется все в срытном режиме



        'Добавить данные в ячейки первого листа новой книги

        Exc.sheets(1).range("A1").value = "Таб. №"

        Exc.sheets(1).range("B1").value = "Ф.И.О."

        Exc.sheets(1).range("C1").value = "Должность"

        Exc.sheets(1).range("D1").value = "Логин"

        Exc.sheets(1).range("E1").value = "Пароль"

        Exc.sheets(1).range("A1:E1").Font.Bold = True

        Exc.sheets(1).range("A1:E1").Font.Size = 11

        Exc.sheets(1).range("A1:E1").Interior.ColorIndex = 6

        Exc.sheets(1).range("A1:E1").HorizontalAlignment = xlCenter

        Exc.sheets(1).range("A1:E1").VerticalAlignment = xlCenter

        Exc.sheets(1).range("A1:E1").WrapText = False

        Exc.sheets(1).range("A1:E1").Orientation = 0

        Exc.sheets(1).range("A1:E1").MergeCells = False



    End Sub



    Private Sub Commit_Click(sender As System.Object, e As System.EventArgs) Handles Commit.Click



        For i = 2 To 10

            Exc.sheets(1).range("A" & i).value = Me.EIDText

            Exc.sheets(1).range("B" & i).value = Me.LFMText

            Exc.sheets(1).range("C" & i).value = Me.TitleText

            Exc.sheets(1).range("D" & i).value = Me.LoginText

            Exc.sheets(1).range("E" & i).value = Me.PwdText

        Next i



        'Сохранить книгу и закрыть Excel

        If Not File.Exists("C:\Users\dmitry.palega\Desktop\EmployeeList.xlsx") Then

            CExc.SaveAs("C:\Users\dmitry.palega\Desktop\EmployeeList.xlsx")

            Exc.Quit()

        Else

            My.Computer.FileSystem.DeleteFile("C:\Users\dmitry.palega\Desktop\EmployeeList.xlsx")

            CExc.SaveAs("C:\Users\dmitry.palega\Desktop\EmployeeList.xlsx")

            Exc.Quit()

        End If

    End Sub

End Class

Цитата:

Цитата Iska

Devils0411, покажите Ваш проект VB.Net. Чтобы можно было рассуждать предметно. »

Вы имеете ввиду окно, где вводятся данные7

Архив с проектом прикрепил.

Проблему решил.. Чуть позже выложу код с изменениями.
P.S. Проблема была в отсутствии Text.ToString, т.е. строка должна была быть вот такой: Exc.sheets(1).range("A" & i).value = Me.EIDText.Text.ToString

Добрый вечер.

Подскажите как ввести формулу в ячейку Excel при помощи VBA. Формула содержит функцию, написанную в VBA и имеет такой синтаксис:
=MyFunc($A16;"15")

iRowNum это переменная с номером строки листа.

Я пробовал так:
Range("G" & CStr(iRowNum)).Formula = "=MyFunc($A" & CStr(iRowNum) & ";" & CStr(15) & ")"

но VBA при запуске выдает:
"Application defined or object defined error".

Цитата:

Цитата stuermer01

но VBA при запуске выдает:
"Application defined or object defined error". »

Полагаю, точка с запятой в VBA должна быть указана как запятая, и кавычки вы не указали - число 15 должно быть в кавычках, для чего нужно поставить две кавычки подряд.
Попробуйте код ниже:
Range("G" & CStr(iRowNum)).Formula = "=MyFunc($A" & CStr(iRowNum) & ",""15"")"

Цитата:

Цитата a_axe

Попробуйте код ниже:
Range("G" & CStr(iRowNum)).Formula = "=MyFunc($A" & CStr(iRowNum) & ",""15"")" »

Заработало! Спасибо.

Подскажите, как ввести через VBA такую формулу в ячейку:

=ЕСЛИ(A4<>"";F4-A4;"--")

пока я ввожу так и это работает:

Range("I" & CStr(iRowNum)).Formula = "=F" & CStr(iRowNum) & "-A" & CStr(iRowNum)

но будет ли скомпилировано имя функции, написанное кириллицей?

stuermer01, запустите макрорекордер и посмотрите, что выйдет. Например:

Код:

Sub Макрос1()

    Range("C6").Select

    ActiveCell.FormulaR1C1 = "=IF(R[-2]C[-2]<>"""",R[-2]C[3]-R[-2]C[-2],""--"")"

    Range("C6").Select

End Sub

Подскажите, как в VBA скопировать только формулу из одной ячейки в другую без использования буфера обмена?
Нужно чтобы формула была приведенная к номеру строки новой ячейки и не менялось форматирование и условное форматирование новой ячейки, т.е. копировалась только формула.
Я этого добился только через copy-paste "вставить только формулы", но это не очень красиво. Можно ли это проделать с помощью метода range().copy или присвоения ?

Можно вставить только формулу. А вот скопировать только формулу в Вашем понимании нельзя.

Код:

Selection.PasteSpecial Paste:=xlPasteFormulas

Цитата:

Цитата Iska

Можно вставить только формулу. А вот скопировать только формулу в Вашем понимании нельзя. »

ну да, тут надо сначала все скопировать в буфер. Т.е. без буфера никак.

stuermer01, именно так.