Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Выбрать дату в календареВыбрать дату в календаре

Страницы: 1 2 3 4 5 6 7 8 9 10 11 След.
Как оставить из текста только числа, но так чтобы они суммировались
 
кузя1972, спасибо
Как оставить из текста только числа, но так чтобы они суммировались
 
Kuzmich, понятно, тогда огромное спасибо
Как оставить из текста только числа, но так чтобы они суммировались
 
Kuzmich, а это функцией можно?
Удалить заполненную строку выше и ниже на одну при заполнении ячейки, макрос
 
Wiss, "я"  это пример
при заполнении ячейки удалить другие с тем же текстом в столбце
Ок и так сойдет, спасибо
было бы еще лучше если при вводе цифр, удалялись только ячейки с текстом
Изменено: Goldenito - 11 Май 2018 18:22:06
Как оставить из текста только числа, но так чтобы они суммировались
 
Код
Function Nolik(txt, Optional s1 = 0, Optional s2 = "")
    Nolik = Replace(txt, s1, s2)
End Function
добавил, теперь работает так =Nolik(iSumma(C17))
Удалить заполненную строку выше и ниже на одну при заполнении ячейки, макрос
 
Wiss, отлично, теперь осталось удалять только при тексте "я"
Удалить заполненную строку выше и ниже на одну при заполнении ячейки, макрос
 
Wiss, в случае внесения чисел (цифр ) не удалять
Удалить заполненную строку выше и ниже на одну при заполнении ячейки, макрос
 
Как сделать макрос, чтобы при заполнении ячейки удалить другие с тем же текстом в столбце
заполняя строку текстом, (исключение цифры) удалить точно такой же текст, только в одном столбце D3:D27
при вводе цифр, удалялись только ячейки с текстом
Изменено: Goldenito - 11 Май 2018 18:34:06
Как оставить из текста только числа, но так чтобы они суммировались
 
Kuzmich, вылазит
#ЗНАЧ!
Изменено: Goldenito - 11 Май 2018 15:27:05
Как оставить из текста только числа, но так чтобы они суммировались
 
Цитата
Kuzmich написал:
оставить только числа в соседнюю ячейку, но так чтобы они суммировались
=iSumma(C19) если пустая ячейка показывает 0 как добавить в код строку, чтобы было пусто
Как оставить из текста только числа, но так чтобы они суммировались
 
Kuzmich, спасибо. отлично вышло
Как оставить из текста только числа, но так чтобы они суммировались
 
Цитата
webley написал:
заменить в функции строку
прикольно получилось, спасибо
Как оставить из текста только числа, но так чтобы они суммировались
 
Сергей, спасибо огромное
Как оставить из текста только числа, но так чтобы они суммировались
 
41389,34+1244,08 Самойлова Ирина Георгиевна - КУМ
66447,78 Ефимов Мари Викторовна - Тик

как оставить только числа в соседнюю ячейку, но так чтобы они суммировались a) 41389,34+1244,08 ее результат сложения b) 66447,78
Изменено: Goldenito - 11 Май 2018 13:50:33
Как сделать настройки поиска макросом со своими настройками, макрос
 
БМВ, отлично работает, огромное спасибо
Как сделать настройки поиска макросом со своими настройками, макрос
 
БМВ, что то непонятное вышло у меня
Код
Sub Поиск()
    Application.CommandBars.ExecuteMso "FindDialogExcel"
.Find(  , , xlValues , 1 , xlByColumns , 1 , False ,  ,) ' . Find( What , After , LookIn , LookAt , SearchOrder , SearchDirection , MatchCase , MatchByte , SearchFormat )
End Sub
Изменено: Goldenito - 28 Апр 2018 17:57:15
Как сделать настройки поиска макросом со своими настройками, макрос
 
Код
Sub Поиск()
    Application.CommandBars.ExecuteMso "FindDialogExcel"
    SendKeys ("0")
End Sub
Здравствуйте
Как сделать настройки поиска: искать значения, ячейка целиком (галочка), искать по столбцам
Запрос на выполнение или отмену макроса
 
Ігор Гончаренко, спасибо
Запрос на выполнение или отмену макроса
 
Код
    If MsgBox("Вы действительно хотите сохранить реестр?", vbOKCancel + vbQuestion, "Accept/Reject") = vbCancel Then
        MsgBox "Завершено"
    Exit Sub
    Else
        Worksheets("Импорт").Activate
    Call SaveTXT_UTF8
сделал)
Запрос на выполнение или отмену макроса
 
Код
Sub Printer()
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
    If MsgBox("Сохранить?", vbYesNo) = vbNo Then Exit Sub
    If MsgBox("Сохранить?", vbYesNo) = vbYes Then Worksheets("Импорт").Activate
    Call SaveTXT_UTF8
End Sub

Здравствуйте не получилось сделать кнопку подтверждения или отмены для выполнения макроса или отменить "сохранить" после печати
спросить выполнять макрос или отменить
[ Закрыто] От полученного значения госпошлины рассчитать исходную сумму взыскания
 
Юрий М, так я о том чтобы код доработать, чтобы при случайной ошибке, не показывало ошибку в  готовом коде
[ Закрыто] От полученного значения госпошлины рассчитать исходную сумму взыскания
 
Цитата
vikttur написал:
к вопросу о пошлине
при неправильном значении пишет ошибку в коде
[ Закрыто] От полученного значения госпошлины рассчитать исходную сумму взыскания
 
Цитата
vikttur написал:
А это каким боком
если случайно стоят другие  буквы или символы показывает ошибку кода
[ Закрыто] От полученного значения госпошлины рассчитать исходную сумму взыскания
 
Ігор Гончаренко, отлично

есть один момент, если вдруг вместо запятой стоит вопросительный знак или вообще что то другое, как прописать "проверьте на корректность"
1567?70
[ Закрыто] От полученного значения госпошлины рассчитать исходную сумму взыскания
 
Пытливый, это как) немного не понял как это сделать
[ Закрыто] От полученного значения госпошлины рассчитать исходную сумму взыскания
 
Цитата
Dima S написал:
что есть и что надо.
из E8 в F8 то есть как то определить как формула считает, и выводить сумму изначальную
Изменено: Goldenito - 13 Апр 2018 21:35:04
[ Закрыто] От полученного значения госпошлины рассчитать исходную сумму взыскания
 
Здравствуйте, есть уже известная сумма госпошлины, но неизвестна первоначальная сумма взыскания. как посчитать
это формула для  расчета госпошлины при известной сумме
Код
=ЕСЛИОШИБКА(МЕДИАНА(400;ВПР(F2;aa;2)+(F2-ВПР(F2;aa;1))*ВПР(F2;aa;3)%;60000)/2;"")

а надо наоборот при известной госпошлине примерно посчитать готовую сумму
Заполнить окрашенную ячейку через формулу,  чтобы при любой сумме госпошлины выходила правильно

из E8 получить в соседней F8 готовый результат
Изменено: Goldenito - 13 Апр 2018 22:07:55
Сохранить с определенных строк в TXT
 
Anchoret, понял, тогда сойдет последнее там вышло все гладко

в итоге я остановился и доработал еще кое-где для удобства )
Спасибо за помощь в начале совершенства кода
Код
  Declare PtrSafe Function MessageBoxTimeOut Lib "User32" Alias "MessageBoxTimeoutA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal uType As VbMsgBoxStyle, ByVal wLanguageId As Long, ByVal dwMilliseconds As Long) As Long
  Declare PtrSafe Function GetSystemMenu Lib "User32" (ByVal hwnd As LongPtr, ByVal bRevert As Long) As LongPtr
  Declare PtrSafe Function RemoveMenu Lib "User32" (ByVal hMenu As LongPtr, ByVal nPosition As Long, ByVal wFlags As Long) As Long
  Declare PtrSafe Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Sub SaveTXT_UTF8()
Dim fp$, txt$, aa As Range, ll&, ADOSt As Object, a%
    On Error Resume Next
    ' создаём папку для файла, если её ещё нет
    MkDir ThisWorkbook.Path & "\" & Range("L2")
    ' выбираем стартовую папку
    ChDrive Left(ThisWorkbook.Path, 1): ChDir ThisWorkbook.Path & "\" & Range("L2")
    ' вывод диалогового окна для запроса имени сохраняемого файла
    Filename = Application.GetSaveAsFilename(Format([L1], "№000 ") & Format(Now, "DD.MM.YYYY DDD., вр.hh-mm-ss") & " Простые письма.txt", "Текстовые файлы (*.txt), ", , "Введите имя файла для сохраняемого отчёта", "Сохранить")
    ' если пользователь отказался от выбора имени файла - отменяем сохранение листа в файл
    If VarType(Filename) = vbBoolean Then Exit Sub
    
    fp = Filename 'копирует в папку
    ll = 2: txt = ""
    Set ADOSt = CreateObject("ADODB.Stream")
    ADOSt.Open: ADOSt.Charset = "utf-8"
    ADOSt.WriteText Replace$(Mid$(fp, Len(fp) - InStr(StrReverse(fp), "\") + 2), ".txt", "") & vbCrLf
    For Each aa In [C2:J35]
  If Len(Range("C" & ll)) > 0 Then
    If aa.EntireRow.Row = ll Then
      txt = txt & Replace$(CStr(aa), Chr(10), " ") & vbTab
    Else
      txt = ll - 1 & vbTab & Left$(txt, Len(txt) - 1) & vbCrLf: ADOSt.WriteText txt
      ll = ll + 1: txt = Replace$(CStr(aa), Chr(10), " ") & vbTab
    End If
  End If
Next
ADOSt.SaveToFile fp, 2
ADOSt.Close
Set ADOSt = Nothing
    Const lSeconds As Long = 3
    MessageBoxTimeOut 0, "Файл сформирован. Папка откроется через 3 секунды", "Goldenito", vbInformation + vbOKOnly, 0&, lSeconds * 1000
    Shell "explorer.exe " & ThisWorkbook.Path & "\" & Range("L2"), vbMaximizedFocus 'vbNormalFocus в нормальном режиме или vbMaximizedFocus в полном раскрытом окне
End Sub
Изменено: Goldenito - 8 Апр 2018 03:00:01
Сохранить с определенных строк в TXT
 
Андрей VG, не смог применить, для меня это сложно
Сохранить с определенных строк в TXT
 
Цитата
Anchoret написал:
Print #1,EncodeUTF8noBOM(...)'точки - это то, что стояло после запятой
иероглифы вышли)
Код
Sub SaveTXT()
Dim fp$, txt$, aa As Range, ll&
fp = "D:\" & Format([L1], "¹000 ") & Format(Now, "DD.MM.YYYY DDD., вр.hh-mm-ss") & " Простые письма.txt"
ll = 2: txt = ""
Open fp For Output As #1
'Print #1, fp 'путь и полное название файла
'Print #1, Mid$(fp, Len(fp) - InStr(StrReverse(fp), "\") + 2) 'название без пути, но с расширением файла
'Print #1, Replace$(Mid$(fp, Len(fp) - InStr(StrReverse(fp), "\") + 2), ".txt", "") 'без пути и расширения
Print #1, Replace$(Mid$(fp, Len(fp) - InStr(StrReverse(fp), "\") + 2), ".txt", "") 'без пути и расширения
'Print #1, Mid$(fp, Len(fp) - InStr(StrReverse(fp), "\") + 2, Len(Format([L1], "¹000"))) 'только "¹0000"
For Each aa In [C2:J35]
  If Len(Range("C" & ll)) > 0 Then
    If aa.EntireRow.Row = ll Then
      txt = txt & CStr(aa) & vbTab
    Else
      Print #1, EncodeUTF8noBOM(ll - 1 & vbTab & Left$(Replace$(txt, Chr(10), " "), Len(Replace$(txt, Chr(10), " ")) - 1))
      ll = ll + 1: txt = CStr(aa) & vbTab
    End If
  End If
Next
Close #1
End Sub

'Функция перекодировки текста в UTF-8 без BOM
Function EncodeUTF8noBOM(ByVal txt As String) As String
    For i = 1 To Len(txt)
        l = Mid(txt, i, 1)
        Select Case AscW(l)
            Case Is > 4095: t = Chr(AscW(l) \ 64 \ 64 + 224) & Chr(AscW(l) \ 64) & Chr(8 * 16 + AscW(l) Mod 64)
            Case Is > 127: t = Chr(AscW(l) \ 64 + 192) & Chr(8 * 16 + AscW(l) Mod 64)
            Case Else: t = l
        End Select
        EncodeUTF8noBOM = EncodeUTF8noBOM & t
    Next
End Function

Страницы: 1 2 3 4 5 6 7 8 9 10 11 След.
Наверх