» Excel VBA (часть 2)

ferias

Цитата:

Содержимое ячейки рано 45,15 (где 45,15 это число) а 45,15 m2 это формат ячейки, тоесть то что мы видим. Так вот, мне удается это сделать вручную, а при записи форматируем ячейку вот в такой формфат # ##0,00\ [$ m2. -1] то, после записи имеем # ##0,00\ [$ m?. -1] . При записи символ "2" меняется на "?" .

Я не совсем уверен, но думаю, что это ограничение ASC-кодировки, которую использует VBA по умолчанию. Чтобы получить символ "в квадрате" вам надо копать в сторону использования UNICODE.

Добавлено:

Код: Dim str1 as String
' Вот как читать в переменную в формате UNICODE:
' В ячейке символ с кодом 0178 (держим ALT и набираем на NumPad 0178)
str1 =Cells(1, 1).value
' Запись обратно в ячейку
Cells(2, 2).Value = str1
' перевод в ASC, все не-ASC символы будут заменены на вопросы
str1 = StrConv(str1, vbFromUnicode)
' перевод обратно в UNICODE (поскольку мы потеряли
' все не-ASC символы, то получим строчку с вопросиками).
' Данный пример полезен, когда нам надо куда-нибудь передать
' текстовую строку в формате UNICODE.
str1 = StrConv(str1, vbUnicode)

Elena3785
Формат-Ячейки..
а в типе:
[ч]:мм

nick7inc
Тема даже очень интересная... возможность сосдания своих символов... Только каким образом можно узнать номер( код символа)
Цитата:

символ с кодом 0178

, ведь если воспользоватся
Цитата:

Windows charmap.exe.

, то оказывается что порядковый номер совсем не 178-й. И второй вопрос, вернее он был первым. Каким методом я смогу применить к своему формату этот символ "в квадрате", может можно както вставить вместо "2" переменную? Которая будет ровна
Цитата:

"M" + ChrW(&HB2)

?
Спасибо огромное.

ecolesnicov
Работает. Спасибо!

Возможно глупый вопрос, но очень срочно надо.
Как создать файл без шаблона, просто новый файл в папке с файлом макроса, с определенным именем?

Luciefer
Например, так:

Код: Dim FileN As String
FileN = "MyName.xls"
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & Application.PathSeparator & FileN

ferias и CEMEH
Ребята, спасибо за подсказку.

2SAS888, спасибо...получилось

Добавлено:
еще такой вопрос:

копирую значение из одного файла в другой таким обазом:
ActiveWorkbook.ActiveSheet.Cells(i, 2) = Workbooks("buh.xls").Worksheets("Лист1").Cells(i, 2)

Все ок, но, мне надо что бы можно было копировать, даже если файл buh.xls не открыт, и что бы значение полностью копировалось, а не просто ссылка (как это сделано вот тут 'ActiveWorkbook.ActiveSheet.Cells(i, 2).Value = "='[buh.xls]Лист1'!RC"
).

Добавлено:
и еще вопрос
в первом файле примерно такой текст

5800005    30302840910002000001    70601810010001210221    50,00    1187.62    1187.62    08.05.2008
Итого (11/05/2008) документов 1 на сумму 100.00                        
12/05/2008                        
5800005    30302840910002000001    70601810010001210221    50,00    1187.62    1187.62    08.05.2008
5800005    30302840910002000001    70601810010001210221    50,00    1187.62    1187.62    08.05.2008
5800005    30302840910002000001    70601810010001210221    50,00    1187.62    1187.62    08.05.2008


Надо удалить строки с итоог и датой при копировании
как это сделать, к чему прицепиться?

Luciefer
В VBA нет возможности получить данные из закрытой рабочей книги.
Есть два варианта это сделать:
1) На свободном месте рабочего листа создать ссылку на ячейку в другой книге, затем скопировать полученное значение (именно значение) и результат использовать по назначению.
2) Воспользоваться функцией XML:

Код: Dim arg As String
arg = "'" & ThisWorkbook.path & "\[buh.xls]Лист1'!" & Cells(i, 2).Range("A1").Address(, , xlR1C1)
ActiveWorkbook.ActiveSheet.Cells(i, 2) = ExecuteExcel4Macro(arg)

ну..примерн понятно

еще вопрос

у меня копируется сейчас примерно 15000 записей. Естественно все это копируется долго и экран мелькает. Как можно сделать что бы не было мельканий. не было ничего или просто часы песочные были, в общем что бы красиво выглядело а не мелало?

Код: Application.ScreenUpdating = False

Luciefer
Попробуй Application.ScreenUpdating = false

Спасибо.
Очередной вопрос (простите уж меня, ну не шарю я пока в VBA)
Сделал примерно таким образом копирование ячеек

ActiveWorkbook.ActiveSheet.Cells(i, 4) = Workbooks("buh.xls").Worksheets("Лист1").Cells(j, 4)
ActiveWorkbook.ActiveSheet.Columns("D:D").NumberFormat = "0.00"

У меня стоит Office 2003. На другом компе х.з. У меня все ок работает а на другом компе в итоге в ячейках отображаются только целые числа, не целые не отображаются - просто пустая ячейка.

В чем может быть дело?

Добавлено:
нужно преобразовать из текста в число 47427810310040000024
если ставлю формат как числовой, то последние цифры изменяются на 00, какой формат использовать для таких чисел кроме текстового? желательно что бы понималось как числа

По-другому никак.
Для того, чтобы иметь возможность работать как с числами - можно в коде макроса преобразовывать формат в Decimal, делать все математические операции, затем, то, что получилось возвращать в текстовый формат и выводить в ячейку листа.
Например:
Пусть даны переменные x и y в текстовом формате. Сложить их можно так:

Код: z = CStr(CDec(x) + CDec(y))

Luciefer

Цитата:

преобразовать из текста в число 47427810310040000024

Excel работает только с пятнадцатизначными числам.

Помоги те пожалуйста я написал макрос для печати выделенного фрагмента а можно ли еще и сохранить его как нибудь на диск скажем в формате .txt или что нить в духе
Private Sub CommandButton1_Click()

Range("A1:J34").Select
Range("J34").Activate
Selection.PrintOut Copies:=1, Collate:=True

End Sub

Большое спасибо заранее очень нужно

MRyuka
Посмотри Здесь.

В скрипте ниже берется ФИО и преобразуется в лат фамилия и имя отчество сокращается до двух символов: Ларина Лариса Юрьевна -> larinalyu. Можно оставить только один символ имени, отчества? что бы получилось: larinaly


Код: Function latinStr(ByVal sStr As String)
Dim iCount, i As Integer
Dim sChar As String
Dim Res As String
Dim ByCode As Integer


Res = ""
iCount = Len(sStr)
For i = 1 To iCount Step 1
sChar = Mid(sStr, i, 1)
Select Case sChar
Case "ô", "Ô"
Res = Res + "f"
Case "û", "Û"
Res = Res + "y"
Case "â", "Â"
Res = Res + "v"
Case "à", "À"
Res = Res + "a"
Case "ï", "Ï"
Res = Res + "p"
Case "ð", "Ð"
Res = Res + "r"
Case "î", "Î"
Res = Res + "o"
Case "ë", "Ë"
Res = Res + "l"
Case "ä", "Ä"
Res = Res + "d"
Case "æ", "Æ"
Res = Res + "zh"
Case "ý", "Ý"
Res = Res + "e"
Case "é", "É"
Res = Res + "y"
Case "ö", "Ö"
Res = Res + "c"
Case "ó", "Ó"
Res = Res + "u"
Case "ê", "Ê"
Res = Res + "k"
Case "å", "Å"
Res = Res + "e"
Case "í", "Í"
Res = Res + "n"
Case "ã", "Ã"
Res = Res + "g"
Case "ø", "Ø"
Res = Res + "h"
Case "ù", "Ù"
Res = Res + "ch"
Case "ç", "Ç"
Res = Res + "z"
Case "õ", "Õ"
Res = Res + "h"
Case "ú", "Ú"
Res = Res + ""
Case "ÿ", "ß"
Res = Res + "ya"
Case "÷", "×"
Res = Res + "ch"
Case "ñ", "Ñ"
Res = Res + "s"
Case "ì", "Ì"
Res = Res + "m"
Case "è", "È"
Res = Res + "i"
Case "ò", "Ò"
Res = Res + "t"
Case "ü", "Ü"
Res = Res + ""
Case "á", "Á"
Res = Res + "b"
Case "þ", "Þ"
Res = Res + "yu"
End Select
Next
latinStr = Res
End Function


Function ConvertFIO(ByVal sBuff As String)
Dim sF, sI, sO As String
Dim pos As Integer
sBuff = Trim(sBuff)
pos = InStr(1, sBuff, " ", vbTextCompare)
If pos < 1 Then
ConvertFIO = "error"
Return
End If
sF = Left(sBuff, pos - 1)
sBuff = Mid(sBuff, pos + 1)
pos = InStr(1, sBuff, " ", vbTextCompare)
If pos > 0 Then
sI = Left(sBuff, 1)
sO = Mid(sBuff, pos + 1, 1)
End If
ConvertFIO = latinStr(sF) & latinStr(sI) & latinStr(sO)
End Function

abasov
Может быть Так:

Код: Function ABC(Data)
Dim a() As String, i As Integer
Rus = "АБВГДЕЁЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯабвгдеёжзийклмнопрстуфхцчшщъыьэюя"
Trans = Array("", "A", "B", "V", "G", "D", "E", "Jo", "Zh", "Z", "I", "Jj", _
"K", "L", "M", "N", "O", "P", "R", "S", "T", "U", "F", "H", "C", "Ch", "Sh", _
"Zch", "''", "'Y", "'", "Eh", "Ju", "Ja", "a", "b", "v", "g", "d", "e", _
"jo", "zh", "z", "i", "jj", "k", "l", "m", "n", "o", "p", "r", "s", "t", "u", _
"f", "h", "c", "ch", "sh", "zch", "''", "'y", "'", "eh", "ju", "ja")

For i = 1 To 65
Data = Replace(Data, Mid(Rus, i, 1), Trans(i), , , vbBinaryCompare)
Next

If Data = "" Then Exit Function
a = Split(Data, " ")
If UBound(a) < 2 Then Exit Function
Data = a(0) & Left(a(1), 1) & Left(a(2), 1)
ABC = Data

End Function

SAS888
то что доктор прописал, спасибо большое

SAS888 спасибо большое ща буду разбираться=) еще раз большое спасибо

SAS888
почему-то Я не правильно транслит:
Каплунская Татьяна Петровна - KaplunskaяTP

А если так?:

Код: For i = 1 To 66
Data = Replace(Data, Mid(Rus, i, 1), Trans(i), , , vbBinaryCompare)
Next

The okk
Мля...как стыдно, сенк

Извиняюсь, действительно, два "наших" алфавита - это 66 букв.

ferias

Цитата:

каким образом можно узнать номер(код символа)
[...]
ведь если воспользоватся
Цитата:Windows charmap.exe. , то оказывается что порядковый номер совсем не 178-й.

Смотря в какой системе исчисления. У меня Charmap показывает код символа "в квадрате" U+00B2, если перевести в десятичную систему из шестнадцатиричной, то получаем как раз 0178 (ноль в начале нужен для ввода кода символа с клавиатуры при помощи клавиши ALT). Для перевода можно воспользоваться штатной программой "Калькулятор" в Windows.

Цитата:

Каким методом я смогу применить к своему формату этот символ "в квадрате", может можно както вставить вместо "2" переменную?

[more=Легко! Далее...]
Надеюсь, что вы знаете, что делает оператор With?

Код:
' здесь указываем ячейку или диапазон, в котором мы меняем формат данных
With Cells(2, 2)
Делаем вывод числа в виде 1.00x2
' так, указывая код символа в десятичной форме
.NumberFormat = "0.00" + Chr$(34) + "x" + ChrW(178) + Chr$(34)
' или так, указывая код символа в шестнадцатиричной форме
' .NumberFormat = "0.00" + Chr$(34) + "x" + ChrW(&HB2) + Chr$(34)
' Chr$(34) - код символа двойные кавычки

' Просто вводим в ячейку значение, чтобы увидеть результат.
.Value = 1
End With

есть масив

A1 b1 c1
A2 b2 c2
A3 b3 c3
………......
A15 b15 c15

нужно его обработать и в ставить в ячейке так
a1
b1
c1

a2
b2
c2
....
a15
b15
c15

Tarasyan
Пусть на листе 1 - Ваши данные в диапазоне "A1:C15".
Следующий макрос сформирует на листе 2 требуемый вид записи данных.

Код: Sub Main()
Dim i As Integer, j As Integer, n As Integer
Sheets(2).Columns("A").ClearContents: n = 1
For i = 1 To 15
For j = 1 To 3
Sheets(2).Cells(n, "A") = Sheets(1).Cells(i, j): n = n + 1
Next
n = n + 1
Next
End Sub

Много раз устанавливал офис и всегда у меня был элемент ActiveX - RefEdit. Как оказалось бывает и по другому.
C чем связано отсутствие этого элемента в системе? Может что-то пропускается при выборе компонентов установки Офиса?

nick7inc
Спасибо, за помощь и учение.