Компьютерный форум 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)

PhilB 09-03-2012 14:39 1875493

[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". Пробовал разные вариации на тему, но получается та же ошибка.
Как реализовать банальнейшее присвоение значения ячейке???

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

Iska 09-03-2012 20:50 1875732

Цитата:

Цитата 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



PhilB 09-03-2012 21:48 1875770

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

Worksheets("Лист1").Cells(curRowInKvit, curCollumnInKvit).FormulaR1C1 = "=Лист2!G"
Так не работает (а хотелось бы :)):
Код:

Worksheets("Лист1").Cells(curRowInKvit, curCollumnInKvit).FormulaR1C1 = "=Лист2!G" + Str(curRow)
Вариант с .Formula тоже пробовал. Проблема та же.

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

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

Iska 10-03-2012 00:02 1875865

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

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

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

PhilB 10-03-2012 17:46 1876269

Суть задачи:
Есть 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, спасибо за внимание.

Iska 10-03-2012 23:12 1876474

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

Цитата:

Цитата 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)

PhilB 11-03-2012 22:43 1877193

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

Cells(curRowInKvit, curCollumnInKvit).Formula = "=Лист2!G" + СStr(curRow)
Iska, благодарю за помощь!

Iska 12-03-2012 01:22 1877305

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

Евгений_Косьяненко@fb 08-06-2013 06:17 2164226

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

Iska 08-06-2013 11:25 2164299

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

Devils0411 14-01-2015 15:27 2455954

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

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. С третьим вопросом разобрался.

Iska 14-01-2015 17:06 2456016

Цитата:

Цитата 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") »


Devils0411 14-01-2015 17:07 2456019

Теперь выдает следующую ошибку: Член группы не найден. (Исключение из 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

Devils0411 14-01-2015 17:12 2456026

Вложений: 1
Архив с проектом прикрепил.

Devils0411 15-01-2015 10:23 2456301

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

stuermer01 25-02-2018 19:30 2800121

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

Подскажите как ввести формулу в ячейку 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".

a_axe 26-02-2018 09:42 2800202

Цитата:

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

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

stuermer01 27-02-2018 00:39 2800437

Цитата:

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

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

stuermer01 09-07-2019 15:30 2878920

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

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

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

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

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

Iska 09-07-2019 17:34 2878950

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



Время: 15:35.

Время: 15:35.
© OSzone.net 2001-