Показать полную графическую версию : [решено] [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". Пробовал разные вариации на тему, но получается та же ошибка.
Как реализовать банальнейшее присвоение значения ячейке???
Понимаю, что задача банальна, но как ни смешно, не могу понять как это закодировать.
На последней приведенной строке возникает 1004 ошибка "Application-defined or object-defined error". Пробовал разные вариации на тему, но получается та же ошибка. »
PhilB, недостаточно приведённых данных для ответа.
Как реализовать банальнейшее присвоение значения ячейке??? »
Именно так, как у Вас написано. Но Вы хотите присвоить ячейке не значение, а формулу. Соответственно, Вы должны использовать не свойство «.Value», а свойства .Formula (http://msdn.microsoft.com/en-us/library/bb213521%28v=office.12%29.aspx)/.FormulaLocal (http://msdn.microsoft.com/en-us/library/bb213525%28v=office.12%29.aspx) или .FormulaR1C1 (http://msdn.microsoft.com/en-us/library/bb213527%28v=office.12%29.aspx)/.FormulaR1C1Local (http://msdn.microsoft.com/en-us/library/bb213529%28v=office.12%29.aspx).
Using Microsoft Excel Worksheet Functions in Visual Basic [Excel 2003 VBA Language Reference] (http://msdn.microsoft.com/en-us/library/aa221602(v=office.11).aspx):
…
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, я уже говорил выше:
…недостаточно приведённых данных для ответа. »
Приведите весь код.
Суть задачи:
Есть 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, спасибо за внимание.
К сожалению, чтобы воспроизвести ошибку — мне понадобятся все Ваши данные. Так что, сие, скорее всего, отпадает.
Так не работает (а хотелось бы ):
Worksheets("Лист1").Cells(curRowInKvit, curCollumnInKvit).FormulaR1C1 = "=Лист2!G" + Str(curRow)»
«.FormulaR1C1()» предусматривает задание адреса в стиле «R1C1», наподобие «=Лист2!R[7]C[1]».
Вариант с .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
08-06-2013, 06:17
Не могу снять сумму с массива данных, ибо некоторые из этих данных по условию ложны. Не могу дать нулевое значение ложной переменной.
Я, честное слово, не умею на вашем языке разговаривать.
Но, если я пытаюсь научить ячейку показывать ноль, при ложном значении, но, числовое значение, при истинном, то возникает цикличность, формула не работает. Это никак не обойти?
Евгений_Косьяненко@fb, выложите Вашу рабочую книгу. Укажите диапазон массива.
Devils0411
14-01-2015, 15:27
Доброго времени суток. Подскажите пожалуйста, есть такой код:
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, покажите Ваш проект VB.Net. Чтобы можно было рассуждать предметно.
Во-вторых, где можно почитать про форматирование ячеек? Хотелось бы задать текст по центру, шрифт и.т.д. »
В справке Microsoft Office. В MSDN.
P.S. ссылку на Microsoft Office 14.0 Object Library делал... Но как ей воспользоваться - не знаю »
Вы ей уже пользуетесь:
xlCenter »
но местами.
Dim Exc As Object = CreateObject("Excel.Application") »
Devils0411
14-01-2015, 17:07
Теперь выдает следующую ошибку: Член группы не найден. (Исключение из 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
Devils0411, покажите Ваш проект VB.Net. Чтобы можно было рассуждать предметно. »
Вы имеете ввиду окно, где вводятся данные7
Devils0411
14-01-2015, 17:12
Архив с проектом прикрепил.
Devils0411
15-01-2015, 10:23
Проблему решил.. Чуть позже выложу код с изменениями.
P.S. Проблема была в отсутствии Text.ToString, т.е. строка должна была быть вот такой: Exc.sheets(1).range("A" & i).value = Me.EIDText.Text.ToString
stuermer01
25-02-2018, 19:30
Добрый вечер.
Подскажите как ввести формулу в ячейку 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".
но 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
Попробуйте код ниже:
Range("G" & CStr(iRowNum)).Formula = "=MyFunc($A" & CStr(iRowNum) & ",""15"")" »
Заработало! Спасибо.
stuermer01
09-07-2019, 15:30
Подскажите, как ввести через 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
© OSzone.net 2001-2012
vBulletin v3.6.4, Copyright ©2000-2025, Jelsoft Enterprises Ltd.